Excel macro for moving content
Closed
Report
ExcelHelp3

rizvisa1
rizvisa1
 Posts
 4476
 Registration date
 Thursday January 28, 2010
 Status
 Contributor
 Last seen
 August 2, 2020
Related:
 Excel macro for moving content
 Excel macro auto increment number  HowTo  Excel
 Excel macro active sheet ✓  Forum  Excel
 Excel macro create new workbook and copy data ✓  Forum  Excel
 Excel macro to merge cells based on condition ✓  Forum  Excel
 Excel macro compare two sheets and highlight differences ✓  Forum  Excel
3 replies
roylone
I have data in 4 cells grouped together as...
Name Address
Phone Email
I would like to find a macro that will move the column data to rows (removing the old data from the spreadsheet), to look like...
Name Address Phone Email
Any help here would be appreciated. Also, there are no blank rows in current data set.
Name Address
Phone Email
I would like to find a macro that will move the column data to rows (removing the old data from the spreadsheet), to look like...
Name Address Phone Email
Any help here would be appreciated. Also, there are no blank rows in current data set.
rizvisa1
 Posts
 4476
 Registration date
 Thursday January 28, 2010
 Status
 Contributor
 Last seen
 August 2, 2020
You can try this . "doCleanUp" is the main routine that needs to be executed
Public Sub doCleanup() Dim lStartRow As Long Dim lEndRow As Long Dim lMaxRows As Long Dim lTestRow As Long With ActiveSheet lStartRow = 0 lMaxRows = getItemRowLocation("*", .Cells, False, True) If (lMaxRows = 0) Then Exit Sub lStartRow = getItemRowLocation("*", .Range(.Cells(lStartRow + 1, "A"), .Cells(lMaxRows, "A")), False, False) Do Until lStartRow = 0 lEndRow = getItemRowLocation("*", .Range(.Cells(lStartRow + 1, "A"), .Cells(lMaxRows, "A")), , False) If lEndRow = 0 _ Then lEndRow = lMaxRows Else lEndRow = lEndRow  1 End If lTestRow = getItemRowLocation(81000, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False) If (lTestRow > 0) Then .Cells(lStartRow, "F") = .Cells(lTestRow, "F") If (lStartRow <> lEndRow) _ Then .Rows(lStartRow + 1 & ":" & lEndRow).Delete lMaxRows = lMaxRows  (lEndRow  lStartRow) End If Else .Rows(lStartRow & ":" & lEndRow).Delete lMaxRows = lMaxRows  (lEndRow  lStartRow + 1) lStartRow = lStartRow  1 End If If lMaxRows <= lStartRow Then Exit Sub lStartRow = getItemRowLocation("*", .Range(.Cells(lStartRow + 1, "A"), .Cells(lMaxRows, "A")), , False) Loop End With End Sub Public Function getItemRowLocation(sLookFor As String, _ rngSearch As Range, _ Optional bFullString As Boolean = True, _ Optional bLastOccurance As Boolean = True) As Long ' get last use row on the sheet Dim Cell As Range Dim iLookAt As Integer Dim iSearchDir As Integer If (bFullString) _ Then iLookAt = xlWhole Else iLookAt = xlPart End If If (bLastOccurance) _ Then iSearchDir = xlPrevious Else iSearchDir = xlNext End If With rngSearch If (bLastOccurance) _ Then Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, xlByRows, iSearchDir) Else Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, xlByRows, iSearchDir) End If End With If Cell Is Nothing Then getItemRowLocation = 0 Else getItemRowLocation = Cell.Row End If Set Cell = Nothing End Function
ExcelHelp3
That is almost perfect. How do I change the code if I want it to keep sets that have either 81000 or 81001 or 81002 or 81003 or 81010 or 81011 or 81012 or 81013 in column F within the set?
rizvisa1
 Posts
 4476
 Registration date
 Thursday January 28, 2010
 Status
 Contributor
 Last seen
 August 2, 2020
you need to explain "set" part. could 81000 and 81001 both appear on one set. if so then what.
if each number can only appear only once in a set then
convert this statement into a function
lTestRow = getItemRowLocation(81000, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False)
test for each possible value in the set (HINT if lTestRow >0, then you have found your match and you can get out of the function
return the result of match
if each number can only appear only once in a set then
convert this statement into a function
lTestRow = getItemRowLocation(81000, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False)
test for each possible value in the set (HINT if lTestRow >0, then you have found your match and you can get out of the function
return the result of match
ExcelHelp3
It is highly unlikely that multiple numbers would appear in one set, since the presence of one number excludes the others.
So the code you suggest should work, but I'm having trouble understanding what you mean by converting it into a function. If I make it an "or" statement for any of the values, everything gets lost.
So the code you suggest should work, but I'm having trouble understanding what you mean by converting it into a function. If I make it an "or" statement for any of the values, everything gets lost.
rizvisa1
 Posts
 4476
 Registration date
 Thursday January 28, 2010
 Status
 Contributor
 Last seen
 August 2, 2020
Highly unlikely means that it can happen and that's the worse case situation for which you have to program. If you say it will never happen that you can ignore that point, but you are not excluding this possibility
In function you search one by one all possible candidate till you found one or exhausted the list. But if you want to stay away from function you can have a bunch of if statement
like this
lTestRow = getItemRowLocation(81000, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False)
if (lTestRow =0) then
lTestRow = getItemRowLocation(81001, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False)
end if
if (lTestRow =0) then
lTestRow = getItemRowLocation(81002, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False)
end if
and so on..
In function you search one by one all possible candidate till you found one or exhausted the list. But if you want to stay away from function you can have a bunch of if statement
like this
lTestRow = getItemRowLocation(81000, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False)
if (lTestRow =0) then
lTestRow = getItemRowLocation(81001, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False)
end if
if (lTestRow =0) then
lTestRow = getItemRowLocation(81002, .Range(.Cells(lStartRow, "F"), .Cells(lEndRow, "F")), True, False)
end if
and so on..