Sub article1_total_usage_normalize()
Dim rngName As Range
Dim rngArray() As String
Dim ad As String
Dim keyRange As Range
Dim ws As Worksheet
Dim firstAddress As String
Dim i&, j&, k&, n&, urColumn$
Dim sort_str As String
Dim save_doi As String
Dim totArray() As Integer
urColumn = "A"
Set ws = ActiveWorkbook.ActiveSheet
With ws
For i = ws.Range(urColumn & Rows.Count).End(xlUp).Row To 2 Step -1
If InStr(.Cells(i, 1).Value, "_Supplement") Then
.Rows(i).EntireRow.Delete shift:=xlUp
ElseIf InStr(.Cells(i, 1).Value, "_MeetingAbstracts") Then
.Rows(i).EntireRow.Delete shift:=xlUp
End If
Next i
i = 0
sort_str = ""
Set rngName = .Rows("1:1").Find(What:="abstract_*", MatchCase:=False, After:=Cells(1, 1))
If Not rngName Is Nothing Then
firstAddress = rngName.Address
Do
If (sort_str = "") Then
sort_str = rngName.Column
Else
sort_str = sort_str & "; " & rngName.Column
End If
i = i + 1
Set rngName = .Rows("1:1").Find(What:="abstract_*", MatchCase:=False, After:=Cells(1, rngName.Column))
Loop While Not rngName Is Nothing And rngName.Address <> firstAddress
End If
If (i > 0) Then
rngArray = Split(sort_str, "; ")
For j = 0 To UBound(rngArray)
k = CInt(rngArray(j))
.Columns(k - j).EntireColumn.Delete shift:=xlToLeft
Next j
End If
i = 0
sort_str = ""
Set rngName = .Rows("1:1").Find(What:="pdf_*", MatchCase:=False, After:=Cells(1, 1))
If Not rngName Is Nothing Then
firstAddress = rngName.Address
Do
If (sort_str = "") Then
sort_str = rngName.Column
Else
sort_str = sort_str & "; " & rngName.Column
End If
i = i + 1
Set rngName = .Rows("1:1").Find(What:="pdf_*", MatchCase:=False, After:=Cells(1, rngName.Column))
Loop While Not rngName Is Nothing And rngName.Address <> firstAddress
End If
If (i > 0) Then
rngArray = Split(sort_str, "; ")
For j = 0 To UBound(rngArray)
k = CInt(rngArray(j))
.Columns(k - j).EntireColumn.Delete shift:=xlToLeft
Next j
End If
i = 0
sort_str = ""
Set rngName = .Rows("1:1").Find(What:="full_*", MatchCase:=False, After:=Cells(1, 1))
If Not rngName Is Nothing Then
firstAddress = rngName.Address
Do
If (sort_str = "") Then
sort_str = rngName.Column
Else
sort_str = sort_str & "; " & rngName.Column
End If
i = i + 1
Set rngName = .Rows("1:1").Find(What:="full_*", MatchCase:=False, After:=Cells(1, rngName.Column))
Loop While Not rngName Is Nothing And rngName.Address <> firstAddress
End If
If (i > 0) Then
rngArray = Split(sort_str, "; ")
For j = 0 To UBound(rngArray)
k = CInt(rngArray(j))
.Columns(k - j).EntireColumn.Delete shift:=xlToLeft
Next j
End If
i = 0
sort_str = ""
Set rngName = .Rows("1:1").Find(What:="combined_*", MatchCase:=False, After:=Cells(1, 1))
If Not rngName Is Nothing Then
firstAddress = rngName.Address
Do
If (sort_str = "") Then
sort_str = rngName.Column
Else
sort_str = sort_str & "; " & rngName.Column
End If
i = i + 1
Set rngName = .Rows("1:1").Find(What:="combined_*", MatchCase:=False, After:=Cells(1, rngName.Column))
Loop While Not rngName Is Nothing And rngName.Address <> firstAddress
End If
If (i > 0) Then
rngArray = Split(sort_str, "; ")
For j = 0 To UBound(rngArray)
k = CInt(rngArray(j))
.Columns(k - j).EntireColumn.Delete shift:=xlToLeft
Next j
End If
i = 0
sort_str = ""
Set rngName = .Rows("1:1").Find(What:="total_*", MatchCase:=False, After:=Cells(1, 1))
If Not rngName Is Nothing Then
firstAddress = rngName.Address
Do
If (sort_str = "") Then
sort_str = rngName.Column
Else
sort_str = sort_str & "; " & rngName.Column
End If
i = i + 1
Set rngName = .Rows("1:1").Find(What:="total_*", MatchCase:=False, After:=Cells(1, rngName.Column))
Loop While Not rngName Is Nothing And rngName.Address <> firstAddress
End If
If (i > 0) Then
rngArray = Split(sort_str, "; ")
With .Sort
.SortFields.Clear
For j = 0 To UBound(rngArray)
k = CInt(rngArray(j))
Set keyRange = ws.Cells(k).EntireColumn
.SortFields.Add Key:=keyRange, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Next j
.SetRange ws.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
k = CInt(rngArray(0))
Do While (.Cells(2, k).Value = 0) And (.Cells(2, k).Value <> "")
For i = 2 To ws.Range(urColumn & Rows.Count).End(xlUp).Row
If (.Cells(i, k).Value = 0) Then
.Cells(i, k).Delete shift:=xlToLeft
Else
Exit For
End If
Next i
Loop
For j = 0 To UBound(rngArray)
k = CInt(rngArray(j))
.Cells(1, k).Value = "Month " & (j + 1)
Next j
End If
End With
End Sub