DocAElstein
08-22-2014, 02:42 AM
'_________________________________________________ _____________
'_________________________________________________ _____________
'
' Slightly modified with lots of Comments
Sub RickRothsteinsConcatenatingBalls()
'NOTE: Change the ## A1 to the address of the top left cell of your
'existing data and change the '### G1 to the address of the top left cell where you want the converted table to go to.
Const ExistingTableAnyCellLocation As String = "A1" '##
Const NewTableLHCornerLocation As String = "G1" '###
Dim SourceTableRange As Range 'Give a name and allow all methods and properties of range object to it
Set SourceTableRange = Range(ExistingTableAnyCellLocation).CurrentRegion ' Give this a specific Range. CurrentRegiuon Property applied to a cell returns a complete range incorporating that cell and any ranges that it either is in or touches
Dim SourceTableRangeTableRowsCount As Byte ' For a small Table allow it to hve up to 255 Rows
Let SourceTableRangeTableRowsCount = SourceTableRange.Rows.Count ' This returns the number of rows in the original table
Dim FinalTableFirstColumnRange As Range
Set FinalTableFirstColumnRange = Range(NewTableLHCornerLocation).Resize(SourceTable RangeTableRowsCount) ' Here the resize Property applied to the Range G1 (or Cell G1 here) returns a range increased by the row number, that is to say a range equal to the first column
SourceTableRange.Columns(1).Resize(, 2).Copy Destination:=FinalTableFirstColumnRange ' This is one way of copying the first two columns of the original table to The final table
FinalTableFirstColumnRange.Columns(2).NumberFormat = "@" ' This gives a format to the second column in the final Table
'FinalTableFirstColumnRange.Offset(0, 1) = _
'Evaluate("IF(ROW()," & SourceTableRange.Columns(2).Address & "&"" - ""&" & SourceTableRange.Columns(3).Address & "&"" - ""&" & SourceTableRange.Columns(4).Address & ")")
'FinalTableFirstColumnRange.Offset(0, 1) = _
'Evaluate(" " & SourceTableRange.Columns(2).Address & "&"" - ""&" & SourceTableRange.Columns(3).Address & "&"" - ""&" & SourceTableRange.Columns(4).Address & "")
FinalTableFirstColumnRange.Offset(0, 1) = _
Evaluate(" " & SourceTableRange.Columns(2).Address & " " & "&"" - ""&" & " " & SourceTableRange.Columns(3).Address & " " & "&"" - ""&" & "" & SourceTableRange.Columns(4).Address & "")
SourceTableRange.Columns(5).Copy Destination:=FinalTableFirstColumnRange.Offset(, 2) 'Column 5 of Original table is copied to column 3 of the Final table by setting the destination to 2 colums offset from the first column
FinalTableFirstColumnRange.Cells(1, 0).Offset(0, 1).Value = "Numbers" ' The current heading in the second column is finally overwriten with "Numbers". This is done here by putting the value"Numbers" in the cell which is offset by 1 column to the first cell in the Final Table First Column
End Sub 'RickRothsteinsConcatenatingBalls()
'
''________________________________________________ _______________________________
'_________________________________________________ _________________________________
'_________________________________________________ _____________
' Replacing the line I do not fully understand with a 3 line loop
Sub RickRothsteinsConcatenatingBalls2()
Dim j As Byte
'NOTE: Change the ## A1 to the address of the top left cell of your
'existing data and change the '### G1 to the address of the top left cell where you want the converted table to go to.
Const ExistingTableAnyCellLocation As String = "A1" '##
Const NewTableLHCornerLocation As String = "G1" '###
Dim SourceTableRange As Range 'Give a name and allow all methods and properties of range object to it
Set SourceTableRange = Range(ExistingTableAnyCellLocation).CurrentRegion ' Give this a specific Range. CurrentRegiuon Property applied to a cell returns a complete range incorporating that cell and any ranges that it either is in or touches
Dim SourceTableRangeTableRowsCount As Byte ' For a small Table allow it to have up to 255 Rows
Let SourceTableRangeTableRowsCount = SourceTableRange.Rows.Count ' This returns the number of rows in the original table
Dim FinalTableFirstColumnRange As Range
Set FinalTableFirstColumnRange = Range(NewTableLHCornerLocation).Resize(SourceTable RangeTableRowsCount) ' Here the resize Property applied to the Range G1 (or Cell G1 here) returns a range increased by the row number, that is to say a range equal to the first column
SourceTableRange.Columns(1).Resize(, 2).Copy Destination:=FinalTableFirstColumnRange ' This is one way of copying the first two columns of the original table to The final table
FinalTableFirstColumnRange.Columns(2).NumberFormat = "@" ' This gives a format to the second column in the final Table
For j = 2 To SourceTableRangeTableRowsCount Step 1 ' For each column of data
FinalTableFirstColumnRange.Cells(1, 1).Offset(j - 1, 1) = Evaluate("" & SourceTableRange.Cells(j, 2).Address & "" & "&"" - ""&" & "" & SourceTableRange.Cells(j, 3).Address & "" & "&"" - ""&" & "" & SourceTableRange.Cells(j, 4).Address & "") ' the evaluate fuction can be used in VBA to give the reults from a formula in a normal Excel Spreadsheet. Hier we use it simply to give the results of a formula something of the form =B2 & " - " & C2 & " - " & D2. Just a convenient way of doung the concantenating. Further we here maks the addresses B2 C2 D2 variable in a loop. A very tricky syntax!!!
Next j
SourceTableRange.Columns(5).Copy Destination:=FinalTableFirstColumnRange.Offset(, 2) 'Column 5 of Original table is copied to column 3 of the Final table by setting the destination to 2 colums offset from the first column
FinalTableFirstColumnRange.Cells(1, 0).Offset(0, 1).Value = "Numbers" ' The current heading in the second column is finally overwriten with "Numbers". This is done here by putting the value"Numbers" in the cell which is offset by 1 column to the first cell in the Final Table First Column
End Sub 'RickRothsteinsConcatenatingBalls2()
'
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
http://www.eileenslounge.com/viewtopic.php?p=324457#p324457 (http://www.eileenslounge.com/viewtopic.php?p=324457#p324457)
http://www.eileenslounge.com/viewtopic.php?p=324064#p324064 (http://www.eileenslounge.com/viewtopic.php?p=324064#p324064)
http://www.eileenslounge.com/viewtopic.php?p=323960#p323960 (http://www.eileenslounge.com/viewtopic.php?p=323960#p323960)
https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg (https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg)
https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg.ADd4m2zp_xDADd6Nnotj 1C (https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg.ADd4m2zp_xDADd6Nnotj 1C)
s://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgySdtXqcaA27wQLd1t4AaABAg (s://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgySdtXqcaA27wQLd1t4AaABAg)
http://www.eileenslounge.com/viewtopic.php?p=323959#p323959 (http://www.eileenslounge.com/viewtopic.php?p=323959#p323959)
http://www.eileenslounge.com/viewtopic.php?f=30&t=41784 (http://www.eileenslounge.com/viewtopic.php?f=30&t=41784)
http://www.eileenslounge.com/viewtopic.php?p=323966#p323966 (http://www.eileenslounge.com/viewtopic.php?p=323966#p323966)
http://www.eileenslounge.com/viewtopic.php?p=323959#p323959 (http://www.eileenslounge.com/viewtopic.php?p=323959#p323959)
http://www.eileenslounge.com/viewtopic.php?p=323960#p323960 (http://www.eileenslounge.com/viewtopic.php?p=323960#p323960)
http://www.eileenslounge.com/viewtopic.php?p=323894#p323894 (http://www.eileenslounge.com/viewtopic.php?p=323894#p323894)
http://www.eileenslounge.com/viewtopic.php?p=323843#p323843 (http://www.eileenslounge.com/viewtopic.php?p=323843#p323843)
http://www.eileenslounge.com/viewtopic.php?p=323547#p323547 (http://www.eileenslounge.com/viewtopic.php?p=323547#p323547)
http://www.eileenslounge.com/viewtopic.php?p=323516#p323516 (http://www.eileenslounge.com/viewtopic.php?p=323516#p323516)
http://www.eileenslounge.com/viewtopic.php?p=323517#p323517 (http://www.eileenslounge.com/viewtopic.php?p=323517#p323517)
http://www.eileenslounge.com/viewtopic.php?p=323449#p323449 (http://www.eileenslounge.com/viewtopic.php?p=323449#p323449)
http://www.eileenslounge.com/viewtopic.php?p=323226#p323226 (http://www.eileenslounge.com/viewtopic.php?p=323226#p323226)
http://www.eileenslounge.com/viewtopic.php?f=25&t=41702&p=323150#p323150 (http://www.eileenslounge.com/viewtopic.php?f=25&t=41702&p=323150#p323150)
http://www.eileenslounge.com/viewtopic.php?p=323085#p323085 (http://www.eileenslounge.com/viewtopic.php?p=323085#p323085)
http://www.eileenslounge.com/viewtopic.php?p=322955#p322955 (http://www.eileenslounge.com/viewtopic.php?p=322955#p322955)
http://www.eileenslounge.com/viewtopic.php?f=30&t=41659 (http://www.eileenslounge.com/viewtopic.php?f=30&t=41659)
http://www.eileenslounge.com/viewtopic.php?p=322462#p322462 (http://www.eileenslounge.com/viewtopic.php?p=322462#p322462)
http://www.eileenslounge.com/viewtopic.php?p=322356#p322356 (http://www.eileenslounge.com/viewtopic.php?p=322356#p322356)
http://www.eileenslounge.com/viewtopic.php?p=321984#p321984 (http://www.eileenslounge.com/viewtopic.php?p=321984#p321984)
https://eileenslounge.com/viewtopic.php?f=30&t=41610 (https://eileenslounge.com/viewtopic.php?f=30&t=41610)
https://eileenslounge.com/viewtopic.php?p=322176#p322176 (https://eileenslounge.com/viewtopic.php?p=322176#p322176)
https://eileenslounge.com/viewtopic.php?p=322238#p322238 (https://eileenslounge.com/viewtopic.php?p=322238#p322238)
https://eileenslounge.com/viewtopic.php?p=322270#p322270 (https://eileenslounge.com/viewtopic.php?p=322270#p322270)
https://eileenslounge.com/viewtopic.php?p=322300#p322300 (https://eileenslounge.com/viewtopic.php?p=322300#p322300)
http://www.eileenslounge.com/viewtopic.php?p=322150#p322150 (http://www.eileenslounge.com/viewtopic.php?p=322150#p322150)
http://www.eileenslounge.com/viewtopic.php?p=322111#p322111 (http://www.eileenslounge.com/viewtopic.php?p=322111#p322111)
http://www.eileenslounge.com/viewtopic.php?p=322086#p322086 (http://www.eileenslounge.com/viewtopic.php?p=322086#p322086)
https://stackoverflow.com/questions/33868233/shell-namespace-not-accepting-string-variable-but-accepting-string-itself/77888851#77888851 (https://stackoverflow.com/questions/33868233/shell-namespace-not-accepting-string-variable-but-accepting-string-itself/77888851#77888851)
http://www.eileenslounge.com/viewtopic.php?p=322084#p322084 (http://www.eileenslounge.com/viewtopic.php?p=322084#p322084)
http://www.eileenslounge.com/viewtopic.php?p=321822#p321822 (http://www.eileenslounge.com/viewtopic.php?p=321822#p321822)
http://www.eileenslounge.com/viewtopic.php?p=322424#p322424 (http://www.eileenslounge.com/viewtopic.php?p=322424#p322424)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
'_________________________________________________ _____________
'
' Slightly modified with lots of Comments
Sub RickRothsteinsConcatenatingBalls()
'NOTE: Change the ## A1 to the address of the top left cell of your
'existing data and change the '### G1 to the address of the top left cell where you want the converted table to go to.
Const ExistingTableAnyCellLocation As String = "A1" '##
Const NewTableLHCornerLocation As String = "G1" '###
Dim SourceTableRange As Range 'Give a name and allow all methods and properties of range object to it
Set SourceTableRange = Range(ExistingTableAnyCellLocation).CurrentRegion ' Give this a specific Range. CurrentRegiuon Property applied to a cell returns a complete range incorporating that cell and any ranges that it either is in or touches
Dim SourceTableRangeTableRowsCount As Byte ' For a small Table allow it to hve up to 255 Rows
Let SourceTableRangeTableRowsCount = SourceTableRange.Rows.Count ' This returns the number of rows in the original table
Dim FinalTableFirstColumnRange As Range
Set FinalTableFirstColumnRange = Range(NewTableLHCornerLocation).Resize(SourceTable RangeTableRowsCount) ' Here the resize Property applied to the Range G1 (or Cell G1 here) returns a range increased by the row number, that is to say a range equal to the first column
SourceTableRange.Columns(1).Resize(, 2).Copy Destination:=FinalTableFirstColumnRange ' This is one way of copying the first two columns of the original table to The final table
FinalTableFirstColumnRange.Columns(2).NumberFormat = "@" ' This gives a format to the second column in the final Table
'FinalTableFirstColumnRange.Offset(0, 1) = _
'Evaluate("IF(ROW()," & SourceTableRange.Columns(2).Address & "&"" - ""&" & SourceTableRange.Columns(3).Address & "&"" - ""&" & SourceTableRange.Columns(4).Address & ")")
'FinalTableFirstColumnRange.Offset(0, 1) = _
'Evaluate(" " & SourceTableRange.Columns(2).Address & "&"" - ""&" & SourceTableRange.Columns(3).Address & "&"" - ""&" & SourceTableRange.Columns(4).Address & "")
FinalTableFirstColumnRange.Offset(0, 1) = _
Evaluate(" " & SourceTableRange.Columns(2).Address & " " & "&"" - ""&" & " " & SourceTableRange.Columns(3).Address & " " & "&"" - ""&" & "" & SourceTableRange.Columns(4).Address & "")
SourceTableRange.Columns(5).Copy Destination:=FinalTableFirstColumnRange.Offset(, 2) 'Column 5 of Original table is copied to column 3 of the Final table by setting the destination to 2 colums offset from the first column
FinalTableFirstColumnRange.Cells(1, 0).Offset(0, 1).Value = "Numbers" ' The current heading in the second column is finally overwriten with "Numbers". This is done here by putting the value"Numbers" in the cell which is offset by 1 column to the first cell in the Final Table First Column
End Sub 'RickRothsteinsConcatenatingBalls()
'
''________________________________________________ _______________________________
'_________________________________________________ _________________________________
'_________________________________________________ _____________
' Replacing the line I do not fully understand with a 3 line loop
Sub RickRothsteinsConcatenatingBalls2()
Dim j As Byte
'NOTE: Change the ## A1 to the address of the top left cell of your
'existing data and change the '### G1 to the address of the top left cell where you want the converted table to go to.
Const ExistingTableAnyCellLocation As String = "A1" '##
Const NewTableLHCornerLocation As String = "G1" '###
Dim SourceTableRange As Range 'Give a name and allow all methods and properties of range object to it
Set SourceTableRange = Range(ExistingTableAnyCellLocation).CurrentRegion ' Give this a specific Range. CurrentRegiuon Property applied to a cell returns a complete range incorporating that cell and any ranges that it either is in or touches
Dim SourceTableRangeTableRowsCount As Byte ' For a small Table allow it to have up to 255 Rows
Let SourceTableRangeTableRowsCount = SourceTableRange.Rows.Count ' This returns the number of rows in the original table
Dim FinalTableFirstColumnRange As Range
Set FinalTableFirstColumnRange = Range(NewTableLHCornerLocation).Resize(SourceTable RangeTableRowsCount) ' Here the resize Property applied to the Range G1 (or Cell G1 here) returns a range increased by the row number, that is to say a range equal to the first column
SourceTableRange.Columns(1).Resize(, 2).Copy Destination:=FinalTableFirstColumnRange ' This is one way of copying the first two columns of the original table to The final table
FinalTableFirstColumnRange.Columns(2).NumberFormat = "@" ' This gives a format to the second column in the final Table
For j = 2 To SourceTableRangeTableRowsCount Step 1 ' For each column of data
FinalTableFirstColumnRange.Cells(1, 1).Offset(j - 1, 1) = Evaluate("" & SourceTableRange.Cells(j, 2).Address & "" & "&"" - ""&" & "" & SourceTableRange.Cells(j, 3).Address & "" & "&"" - ""&" & "" & SourceTableRange.Cells(j, 4).Address & "") ' the evaluate fuction can be used in VBA to give the reults from a formula in a normal Excel Spreadsheet. Hier we use it simply to give the results of a formula something of the form =B2 & " - " & C2 & " - " & D2. Just a convenient way of doung the concantenating. Further we here maks the addresses B2 C2 D2 variable in a loop. A very tricky syntax!!!
Next j
SourceTableRange.Columns(5).Copy Destination:=FinalTableFirstColumnRange.Offset(, 2) 'Column 5 of Original table is copied to column 3 of the Final table by setting the destination to 2 colums offset from the first column
FinalTableFirstColumnRange.Cells(1, 0).Offset(0, 1).Value = "Numbers" ' The current heading in the second column is finally overwriten with "Numbers". This is done here by putting the value"Numbers" in the cell which is offset by 1 column to the first cell in the Final Table First Column
End Sub 'RickRothsteinsConcatenatingBalls2()
'
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
http://www.eileenslounge.com/viewtopic.php?p=324457#p324457 (http://www.eileenslounge.com/viewtopic.php?p=324457#p324457)
http://www.eileenslounge.com/viewtopic.php?p=324064#p324064 (http://www.eileenslounge.com/viewtopic.php?p=324064#p324064)
http://www.eileenslounge.com/viewtopic.php?p=323960#p323960 (http://www.eileenslounge.com/viewtopic.php?p=323960#p323960)
https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg (https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg)
https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg.ADd4m2zp_xDADd6Nnotj 1C (https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg.ADd4m2zp_xDADd6Nnotj 1C)
s://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgySdtXqcaA27wQLd1t4AaABAg (s://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgySdtXqcaA27wQLd1t4AaABAg)
http://www.eileenslounge.com/viewtopic.php?p=323959#p323959 (http://www.eileenslounge.com/viewtopic.php?p=323959#p323959)
http://www.eileenslounge.com/viewtopic.php?f=30&t=41784 (http://www.eileenslounge.com/viewtopic.php?f=30&t=41784)
http://www.eileenslounge.com/viewtopic.php?p=323966#p323966 (http://www.eileenslounge.com/viewtopic.php?p=323966#p323966)
http://www.eileenslounge.com/viewtopic.php?p=323959#p323959 (http://www.eileenslounge.com/viewtopic.php?p=323959#p323959)
http://www.eileenslounge.com/viewtopic.php?p=323960#p323960 (http://www.eileenslounge.com/viewtopic.php?p=323960#p323960)
http://www.eileenslounge.com/viewtopic.php?p=323894#p323894 (http://www.eileenslounge.com/viewtopic.php?p=323894#p323894)
http://www.eileenslounge.com/viewtopic.php?p=323843#p323843 (http://www.eileenslounge.com/viewtopic.php?p=323843#p323843)
http://www.eileenslounge.com/viewtopic.php?p=323547#p323547 (http://www.eileenslounge.com/viewtopic.php?p=323547#p323547)
http://www.eileenslounge.com/viewtopic.php?p=323516#p323516 (http://www.eileenslounge.com/viewtopic.php?p=323516#p323516)
http://www.eileenslounge.com/viewtopic.php?p=323517#p323517 (http://www.eileenslounge.com/viewtopic.php?p=323517#p323517)
http://www.eileenslounge.com/viewtopic.php?p=323449#p323449 (http://www.eileenslounge.com/viewtopic.php?p=323449#p323449)
http://www.eileenslounge.com/viewtopic.php?p=323226#p323226 (http://www.eileenslounge.com/viewtopic.php?p=323226#p323226)
http://www.eileenslounge.com/viewtopic.php?f=25&t=41702&p=323150#p323150 (http://www.eileenslounge.com/viewtopic.php?f=25&t=41702&p=323150#p323150)
http://www.eileenslounge.com/viewtopic.php?p=323085#p323085 (http://www.eileenslounge.com/viewtopic.php?p=323085#p323085)
http://www.eileenslounge.com/viewtopic.php?p=322955#p322955 (http://www.eileenslounge.com/viewtopic.php?p=322955#p322955)
http://www.eileenslounge.com/viewtopic.php?f=30&t=41659 (http://www.eileenslounge.com/viewtopic.php?f=30&t=41659)
http://www.eileenslounge.com/viewtopic.php?p=322462#p322462 (http://www.eileenslounge.com/viewtopic.php?p=322462#p322462)
http://www.eileenslounge.com/viewtopic.php?p=322356#p322356 (http://www.eileenslounge.com/viewtopic.php?p=322356#p322356)
http://www.eileenslounge.com/viewtopic.php?p=321984#p321984 (http://www.eileenslounge.com/viewtopic.php?p=321984#p321984)
https://eileenslounge.com/viewtopic.php?f=30&t=41610 (https://eileenslounge.com/viewtopic.php?f=30&t=41610)
https://eileenslounge.com/viewtopic.php?p=322176#p322176 (https://eileenslounge.com/viewtopic.php?p=322176#p322176)
https://eileenslounge.com/viewtopic.php?p=322238#p322238 (https://eileenslounge.com/viewtopic.php?p=322238#p322238)
https://eileenslounge.com/viewtopic.php?p=322270#p322270 (https://eileenslounge.com/viewtopic.php?p=322270#p322270)
https://eileenslounge.com/viewtopic.php?p=322300#p322300 (https://eileenslounge.com/viewtopic.php?p=322300#p322300)
http://www.eileenslounge.com/viewtopic.php?p=322150#p322150 (http://www.eileenslounge.com/viewtopic.php?p=322150#p322150)
http://www.eileenslounge.com/viewtopic.php?p=322111#p322111 (http://www.eileenslounge.com/viewtopic.php?p=322111#p322111)
http://www.eileenslounge.com/viewtopic.php?p=322086#p322086 (http://www.eileenslounge.com/viewtopic.php?p=322086#p322086)
https://stackoverflow.com/questions/33868233/shell-namespace-not-accepting-string-variable-but-accepting-string-itself/77888851#77888851 (https://stackoverflow.com/questions/33868233/shell-namespace-not-accepting-string-variable-but-accepting-string-itself/77888851#77888851)
http://www.eileenslounge.com/viewtopic.php?p=322084#p322084 (http://www.eileenslounge.com/viewtopic.php?p=322084#p322084)
http://www.eileenslounge.com/viewtopic.php?p=321822#p321822 (http://www.eileenslounge.com/viewtopic.php?p=321822#p321822)
http://www.eileenslounge.com/viewtopic.php?p=322424#p322424 (http://www.eileenslounge.com/viewtopic.php?p=322424#p322424)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)