Hey all,
I got 2 macros that I want to run in one go. So to explain:
Here is the data of Sheet1 before the macro is run:
<TBODY>
</TBODY>
And here is the result after the macro is run (gets put into Sheet2):
<TBODY>
</TBODY>
So what the macro does is pretty much if a cell is empty on Column B, grabs the entire row and puts it
into Sheet2.
Here is the macro I use to run it:
Sub Macro1()
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1
For Each cell In Sheets(1).Range("B1:B" & lastRow)
If cell.Value = "" Then
cell.EntireRow.Copy Sheets(2).Cells(i, 1)
i = i + 1
End If
Next
End Sub
So after that, I run my second macro on Sheet2 which is:
Sub Macro2()
'for Macro to: Grab data from a row/s then putting it into a column/s then sort by smallest to largest and remove duplicates.
Dim LR As Long
Dim BC As Integer
Dim BC1 As Integer
Dim C As Range
Application.ScreenUpdating = False
'step1 Grab the data from the rows on Column C to V, going down the rows as highlighted and ignoring Columns A & B then put them into column W.
BC = 20 'Number of columns between C & V
LR = ActiveSheet.UsedRange.Rows.Count
Set C = ActiveSheet.Range("C1:C" & LR)
A = 1
B = 3
P = 1
For Each cell In C
BC1 = Application.CountBlank(Range("C" & A & ":V" & A))
Cells(A, B).Resize(, BC - BC1).Copy
Range("W" & P).Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
P = P + (BC - BC1)
A = A + 1
Next
'step2 Sort them by smallest to largest.
LR = Range("W" & Rows.Count).End(xlUp).Row
Set C = ActiveSheet.Range("W1:W" & LR)
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("W1:W" & LR) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("W1:W" & LR)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Step3 Remove duplicates
ActiveSheet.Range("$W$1:$W$" & LR).RemoveDuplicates Columns:=1, Header:=xlNo
'Step4
LR = Range("W" & Rows.Count).End(xlUp).Row
A = 24
For i = 21 To LR Step 20
Cells(i, 23).Resize(20).Cut Destination:=Cells(1, A)
A = A + 1
Next i
Application.ScreenUpdating = True
End Sub
Here is the data before Macro2 is run:
<TBODY>
</TBODY>
And this is after data after Macro2 is run:
<TBODY>
</TBODY>
Keep in mind, when Macro2 is run it puts the data on Column W then X then Y etc as soon as the Column reaches 20 it moves on to the next one.
So my question is:
Is there anyway to combine both macros to just run it once instead of running it individually?
Any questions or if I wasn't to clear on what Im trying to achieve, please don't hesitate to ask.
Thank you all in advance,
Knoxzy
I got 2 macros that I want to run in one go. So to explain:
Here is the data of Sheet1 before the macro is run:
<COLGROUP><COL style="WIDTH: 19pt; mso-width-source: userset; mso-width-alt: 914" width=25><COL style="WIDTH: 48pt" span=11 width=64><TBODY> </TBODY> |
<TBODY>
</TBODY>
And here is the result after the macro is run (gets put into Sheet2):
<COLGROUP><COL style="WIDTH: 48pt" span=10 width=64><TBODY> </TBODY> |
<TBODY>
</TBODY>
So what the macro does is pretty much if a cell is empty on Column B, grabs the entire row and puts it
into Sheet2.
Here is the macro I use to run it:
Sub Macro1()
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1
For Each cell In Sheets(1).Range("B1:B" & lastRow)
If cell.Value = "" Then
cell.EntireRow.Copy Sheets(2).Cells(i, 1)
i = i + 1
End If
Next
End Sub
So after that, I run my second macro on Sheet2 which is:
Sub Macro2()
'for Macro to: Grab data from a row/s then putting it into a column/s then sort by smallest to largest and remove duplicates.
Dim LR As Long
Dim BC As Integer
Dim BC1 As Integer
Dim C As Range
Application.ScreenUpdating = False
'step1 Grab the data from the rows on Column C to V, going down the rows as highlighted and ignoring Columns A & B then put them into column W.
BC = 20 'Number of columns between C & V
LR = ActiveSheet.UsedRange.Rows.Count
Set C = ActiveSheet.Range("C1:C" & LR)
A = 1
B = 3
P = 1
For Each cell In C
BC1 = Application.CountBlank(Range("C" & A & ":V" & A))
Cells(A, B).Resize(, BC - BC1).Copy
Range("W" & P).Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
P = P + (BC - BC1)
A = A + 1
Next
'step2 Sort them by smallest to largest.
LR = Range("W" & Rows.Count).End(xlUp).Row
Set C = ActiveSheet.Range("W1:W" & LR)
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("W1:W" & LR) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("W1:W" & LR)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Step3 Remove duplicates
ActiveSheet.Range("$W$1:$W$" & LR).RemoveDuplicates Columns:=1, Header:=xlNo
'Step4
LR = Range("W" & Rows.Count).End(xlUp).Row
A = 24
For i = 21 To LR Step 20
Cells(i, 23).Resize(20).Cut Destination:=Cells(1, A)
A = A + 1
Next i
Application.ScreenUpdating = True
End Sub
Here is the data before Macro2 is run:
<COLGROUP><COL style="WIDTH: 19pt; mso-width-source: userset; mso-width-alt: 914" width=25><COL style="WIDTH: 48pt" span=10 width=64><TBODY> </TBODY> |
<TBODY>
</TBODY>
And this is after data after Macro2 is run:
<TBODY> </TBODY> |
></o<TBODY>
</TBODY>
Keep in mind, when Macro2 is run it puts the data on Column W then X then Y etc as soon as the Column reaches 20 it moves on to the next one.
So my question is:
Is there anyway to combine both macros to just run it once instead of running it individually?
Any questions or if I wasn't to clear on what Im trying to achieve, please don't hesitate to ask.
Thank you all in advance,
Knoxzy
