MID and CONCATENATE in VBA - vba
I'm having the following issue: I recorded a Macro of me using some MID and CONCATENATE formulas after my macro reorders a ton of data. When I run the macro, I get a #REF error, which I understand. However, is there a VBA Code that could remove that or somehow use the MID and CONCATENATE without creating the #REF error? My code is below and any help would be much appreciated.
Sub Macro4()
'
' Macro4 Macro
'
'
Sheets("Sheet2").Select
Cells.Select
Range("D29").Activate
Selection.ClearContents
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Sheets("Sheet1").Select
'
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(16, 1), Array(21, 1), Array(37, 1), _
Array(42, 1), Array(58, 1), Array(63, 1), Array(79, 1), Array(84, 1), Array(100, 1), Array( _
105, 1), Array(121, 1), Array(129, 1)), TrailingMinusNumbers:=True
Rows("1:6").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Dim lastRow&, g&
Dim findStr$
findStr = "Planning of"
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For g = lastRow To 1 Step -1 ' change this to 2 if you have headers
If Cells(g, 1).Value = findStr Then
'Range(Rows(i), Rows(i - 4)).Select
Range(Rows(g), Rows(g - 4)).EntireRow.Delete
End If
Next g
Dim arr() As Variant
Dim p As Integer, i&
Dim ws As Worksheet
Dim tws As Worksheet
Dim t As Integer
Dim c As Long
Dim u As Long
Set ws = ActiveSheet
Set tws = Worksheets("Sheet2")
i = 1
With ws
Do Until i > 100000
u = 0
For c = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
'If c = .Cells(1, .Columns.Count).End(xlToLeft).Column And .Cells(i, c) <> "" Then
ReDim arr(0) As Variant
p = 0
t = 0
Do Until .Cells(i + p, c) = "" And t = 1
If .Cells(i + p, c) = "" Then
t = 1
Else
arr(UBound(arr)) = .Cells(i + p, c)
ReDim Preserve arr(UBound(arr) + 1)
End If
p = p + 1
Loop
If p > u Then
u = p
End If
If c = .Cells(1, .Columns.Count).End(xlToLeft).Column Then
If .Cells(i + p, c).End(xlDown).Row > 100000 And .Cells(i + p, 1).End(xlDown).Row < 100000 Then
i = .Cells(i + u, 1).End(xlDown).Row
Else
i = .Cells(i + p, c).End(xlDown).Row
End If
End If
tws.Cells(tws.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arr) + 1) = arr
Next c
Loop
End With
With tws
.Rows(1).Delete
For i = .Cells(1, 1).End(xlDown).Row To 2 Step -1
If Left(.Cells(i, 1), 4) <> Left(.Cells(i - 1, 1), 4) Then
.Rows(i).EntireRow.Insert
End If
Next i
End With
'
' Macro6 Macro
'
'
'Sheets("Sheet2").Select
'Range("A1:M67").Select
'Selection.Copy
'Sheets("Output").Select
'Range("A3").Select
'ActiveSheet.Paste
'Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(Sheet2!RC="""","""",Sheet2!RC)"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[1],5,4)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC,1,3)"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC,6,3)"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-1],1,4)"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-2],10,4)"
Range("F2").Select
Columns("F:F").EntireColumn.AutoFit
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",RC[-3])"
Range("H1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-3],5,3)"
Range("H1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-3],6,3)"
Range("I1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-4],1,4)"
Range("J1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-5],10,4)"
Range("K1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-5],6,3)"
Range("K2").Select
Columns("K:K").EntireColumn.AutoFit
Range("G1").Select
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
Range("L1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-6],6,3)"
Range("M1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-7],1,4)"
Range("N1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-8],10,4)"
Range("O1").Select
ActiveCell.FormulaR1C1 = ""
Range("K1").Select
Selection.Copy
Range("O1").Select
ActiveSheet.Paste
Range("O1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",RC[-3])"
Range("P1").Select
Columns("P:P").ColumnWidth = 7.71
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-9],6,3)"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-10],1,4)"
Range("R1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-11],10,4)"
Range("O1").Select
Selection.Copy
Range("S1").Select
ActiveSheet.Paste
Range("T1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-12],6,3)"
Range("U1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-13],1,4)"
Range("V1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-14],10,3)"
Range("V1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-14],10,4)"
Range("V2").Select
Columns("U:U").EntireColumn.AutoFit
Range("S1").Select
Selection.Copy
Range("W1").Select
ActiveSheet.Paste
Range("X1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-15],6,3)"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!R[10]C[-16],1,4)"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-16],1,4)"
Range("Z1").Select
ActiveCell.FormulaR1C1 = ""
Range("W1").Select
Selection.Copy
Range("Z1").Select
ActiveSheet.Paste
Range("Z1").Select
Columns("Z:Z").EntireColumn.AutoFit
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-17],10,4)"
Range("AA1").Select
ActiveCell.FormulaR1C1 = ""
Range("W1").Select
Selection.Copy
Range("AA1").Select
ActiveSheet.Paste
Range("AB1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-18],6,3)"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "=Sheet2!R[113]C[-19]"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "eet2!J114"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-19],1,4)"
Range("AA1").Select
Selection.Copy
Range("AD1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-20],10,4)"
Range("W1").Select
Selection.Copy
Range("AD1").Select
ActiveSheet.Paste
Range("AD1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(OR(RC[-3]="""",AE=""""),"""",RC[-3])"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "=IF(OR(RC[-3]="""",RC[1]=""""),"""",RC[-3])"
Range("A1:AD1").Select
Selection.AutoFill Destination:=Range("A1:AD123"), Type:=xlFillDefault
Range("A1:AD123").Select
ActiveWindow.SmallScroll Down:=-108
Range("V23").Select
ActiveWindow.SmallScroll Down:=-21
Columns("AD:AD").Select
Selection.Copy
Columns("G:G").Select
ActiveSheet.Paste
Columns("K:K").Select
ActiveSheet.Paste
Columns("O:O").Select
ActiveSheet.Paste
Columns("S:S").Select
ActiveSheet.Paste
Columns("W:W").Select
ActiveSheet.Paste
Columns("AA:AA").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-27
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.End(xlToLeft).Select
Sheets("Sheet4").Select
Range("A3").Select
ActiveWindow.SmallScroll Down:=-6
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(Sheet3!R[-2]C="""","""",Sheet3!R[-2]C)"
Range("B3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C,"" "",Sheet3!R[-2]C[1],Sheet3!R[-2]C[2],"" "",Sheet3!R[-2]C[3])"
Range("B3").Select
Selection.Copy
Range("C3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[3],"" "",Sheet3!R[-2]C[4],Sheet3!R[-2]C[5],"" "",Sheet3!R[-2]C[6])"
Range("D3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[6],"" "",Sheet3!R[-2]C[7],Sheet3!R[-2]C[8],"" "",Sheet3!R[-2]C[9])"
Range("E3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[9],"" "",Sheet3!R[-2]C[10],Sheet3!R[-2]C[11],"" "",Sheet3!R[-2]C[12])"
Range("F3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[12],"" "",Sheet3!R[-2]C[13],Sheet3!R[-2]C[14],"" "",Sheet3!R[-2]C[15])"
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[15],"" "",Sheet3!R[-2]C[16],Sheet3!R[-2]C[17], ,Sheet3!R[-2]C[18])"
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[15],"" "",Sheet3!R[-2]C[16],Sheet3!R[-2]C[17],"" "",Sheet3!R[-2]C[18])"
Range("H3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[18],"" "",Sheet3!R[-2]C[19],Sheet3!R[-2]C[20],"" "")"
Range("H3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[18],"" "",Sheet3!R[-2]C[19],Sheet3!R[-2]C[20],"" "",Sheet3!R[-2]C[21])"
Range("H4").Select
Sheets("Sheet3").Select
ActiveWindow.SmallScroll Down:=-12
Sheets("Sheet4").Select
Range("A3:H3").Select
Selection.AutoFill Destination:=Range("A3:H193"), Type:=xlFillDefault
Range("A3:H193").Select
ActiveWindow.SmallScroll Down:=-201
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Output").Select
Range("A1").Select
ActiveWindow.SmallScroll Down:=-12
Sheets("Sheet4").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
ActiveWindow.SmallScroll Down:=-48
Range("A116").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
I couldn't figure out how to fix the VBA so I simply ran the code without the MID and CONCATENATE in there. Once I did that, I copy and pasted my results into a new tab and entered the equations.
Related
No errors, but Macro works using F8 line by line, not when executing the full macro - excel, vba
I have 6 identical macros in one workbook. 4 out of 6 work good, but I have the same issue for the rest. If I run the macro from debug window with F8, I have perfect , expected results. If I run a macro normally, I have not any errors, but the result is obviously wrong. I can guess that at that case , that the macto ignores this part (all mistakes start here), but not sure ActiveSheet.Range("H2").Select ActiveCell.FormulaR1C1 = "=COUNTIF(C[-3],RC[-3])" ActiveSheet.Range("H2").Select Selection.AutoFill Destination:=Range("H2:H" & lastrow) ActiveSheet.Range("H2:H" & lastrow).Select The goal of the macro is to filter one tab, put a few columns in another tab; compare values from one of the columns to another tab, remove duplicates , filter and paste the results in the "Results" tab. When I do this manually I have got 6 rows in a "Result" tab. When I run it normally, I have one row, or nothing.. Can you please kindly advise - what is wrong with this macro? I have tried to put this line in my code (no luck) : Application.PrintCommunication = True I have tried to put DoEvents ThisWorkbook before each Row, Column and Range - no luck Many thanks in advance!! And here is my full code: Public lastrow As Long Public FileName As String Public TabName As String Sub APP_filtering_new() ' ' APP_filtering Macro lastrow = ActiveSheet.Range("A1048576").End(xlUp).Row Sheets("APP-input").Select ActiveSheet.Rows("1:1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$AG$14878").AutoFilter Field:=2, Criteria1:=Array( _ "BRAMPTON", "VANCOUVER, CD", "VANCOUVER", _ "VANCOUVER TERMINAL"), Operator:=xlFilterValues ActiveSheet.Columns("E:E").Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Sheets("APP_output").Select ActiveSheet.Columns("A:A").Select ActiveSheet.Paste Sheets("APP-input").Select ActiveSheet.Columns("N:N").Select Selection.SpecialCells(xlCellTypeVisible).Select Application.CutCopyMode = False Selection.Copy Sheets("APP_output").Select ActiveSheet.Columns("D:D").Select ActiveSheet.Paste Sheets("APP-input").Select ActiveSheet.Columns("G:G").Select Selection.SpecialCells(xlCellTypeVisible).Select Application.CutCopyMode = False Selection.Copy Sheets("APP_output").Select ActiveSheet.Columns("E:E").Select ActiveSheet.Paste ActiveSheet.Range("F2").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = " " ActiveSheet.Range("F2").Select Selection.AutoFill Destination:=Range("F2:F" & lastrow) ActiveSheet.Range("F2:F" & lastrow).Select ActiveSheet.Range("G2").Select ActiveCell.FormulaR1C1 = " " ActiveSheet.Range("G2").Select Selection.AutoFill Destination:=Range("G2:G" & lastrow) ActiveSheet.Range("G2:G" & lastrow).Select ActiveSheet.Range("H2").Select ActiveCell.FormulaR1C1 = "=COUNTIF(C[-3],RC[-3])" ActiveSheet.Range("H2").Select Selection.AutoFill Destination:=Range("H2:H" & lastrow) ActiveSheet.Range("H2:H" & lastrow).Select ActiveSheet.Columns("H:H").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'remove duplicates ActiveSheet.Columns("A:H").Select Application.CutCopyMode = False ActiveSheet.Range("A1:E" & lastrow).RemoveDuplicates Columns:=5, Header:= _ xlNo 'vlookup, IF condition ActiveSheet.Range("I2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],container,4,FALSE)" ActiveSheet.Range("I2").Select Selection.AutoFill Destination:=Range("I2:I" & lastrow) ActiveSheet.Range("I2:I" & lastrow).Select ActiveSheet.Range("J2").Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-1]<RC[-2],""C. has bigger number of Containers"",IF(RC[-1]=RC[-2],""The same amount of containers"",IF(RC[-2]<RC[-1],""The C. has less amount of Containers"")))" ActiveSheet.Range("J2").Select Selection.AutoFill Destination:=Range("J2:J" & lastrow) ActiveSheet.Range("J2:J" & lastrow).Select ActiveSheet.Range("H1").Select ActiveCell.FormulaR1C1 = "Amt of Containers - External report" ActiveSheet.Range("I1").Select ActiveCell.FormulaR1C1 = "Amt of Containers - Internal report" ActiveSheet.Range("J1").Select ActiveCell.FormulaR1C1 = "Result (N/A means New Shipment)" ActiveSheet.Range("H1:J1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlTop .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveSheet.Range("H1:I1").Select ActiveSheet.Range(Selection, Selection.End(xlDown)).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Range("J1").Select ActiveSheet.Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Range("J1").Select Application.CutCopyMode = False Selection.AutoFilter ActiveSheet.Range("D1:J" & lastrow).AutoFilter Field:=7, Criteria1:=Array( _ "#N/A", "C. has bigger number of Containers", _ "The C. has less amount of Containers"), Operator:=xlFilterValues ' paste in next empty row ActiveSheet.Rows("2:2").Select ActiveSheet.Range(Selection, Selection.End(xlDown)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Sheets("Results").Select lastrow = ActiveSheet.Range("A1048576").End(xlUp).Row ActiveSheet.Range("A" & lastrow + 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub
This isn't a full answer, but e.g this block of code ActiveSheet.Range("H2").Select ActiveCell.FormulaR1C1 = "=COUNTIF(C[-3],RC[-3])" ActiveSheet.Range("H2").Select Selection.AutoFill Destination:=Range("H2:H" & lastrow) ActiveSheet.Range("H2:H" & lastrow).Select can be replaced by a single line ActiveSheet.Range("H2:H" & lastrow).FormulaR1C1 = "=COUNTIF(C[-3],RC[-3])" Get rid of ActiveSheet and replace with the actual sheet name.
Copying the first 100 resulted rows after applying a specific criteria to my table
Does anyone know how to take only the first 100 resulted rows after this: =COUNTIFS(R2C9:R50000C9,RC[-1])>30? Here is my code, which I recorded it. Thank you in advance. I hope someone to help me. Sub philoly_3() ' ' philoly_3 Macro ' Sheets("Graph data").Select Range("J1").Select Selection.NumberFormat = "0.00" ActiveCell.FormulaR1C1 = "Criteria" Range("J2").Select ActiveCell.FormulaR1C1 = "=COUNTIFS(R2C9:R50000C9,RC[-1])>30" Range("J2").Select Selection.AutoFill Destination:=Range("J2:J50000") Range("J2:J50000").Select Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Selection.Style = "Input" Range("F2").Select With ActiveWindow .SplitColumn = 0 .SplitRow = 1 End With ActiveWindow.FreezePanes = True Selection.AutoFilter ActiveSheet.Range("$A$1:$J$50000").AutoFilter Field:=10, Criteria1:="TRUE" Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range("A1:I1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("All moments").Select ActiveSheet.Paste Cells.Select Cells.EntireColumn.AutoFit Range("F2").Select With ActiveWindow .SplitColumn = 0 .SplitRow = 1 End With ActiveWindow.FreezePanes = True Sheets("All moments").Select Application.CutCopyMode = False Sheets("All moments").Move Before:=Sheets(1) Sheets("Graph data").Select ActiveSheet.Range("$A$1:$J$50000").AutoFilter Field:=10 Range("I50000").Select Selection.End(xlUp).Select Range("I2").Select Selection.AutoFilter Columns("J:J").Select Selection.Delete Shift:=xlToLeft Range("B2").Select philoly_11 End Sub
Maybe this can help you. Just modify to your needs and implement it in your code. For this, my data range was =B2:E481. My criteria YES/NO is in column E. I copied the first 100 ranges (B:D) that were yes in column E, and pasted them into Z2. Sub COPY_100_FIRST_YES() Dim i As Byte Dim MyRanges As String Dim MyYesRanges() As String Dim MyFinalSelection As Range Range("E2").Select 'first row of my YES/NO column i = 0 Do Until ActiveCell.Value = "" Or i = 100 'Loop until you have 100 yes or there is no more data If ActiveCell.Value = "yes" Then i = i + 1 If MyRanges = "" Then MyRanges = ActiveCell.Row Else MyRanges = MyRanges & "||" & ActiveCell.Row End If End If ActiveCell.Offset(1, 0).Select Loop 'Now I have all rows that are YES and I know the columns i want to copy, in my case is columns B to D, so MyYesRanges() = Split(MyRanges, "||") For i = 0 To UBound(MyYesRanges) Step 1 If i = 0 Then Set MyFinalSelection = Range("B" & MyYesRanges(i) & ":D" & MyYesRanges(i)) Else Set MyFinalSelection = Application.Union(MyFinalSelection, Range("B" & MyYesRanges(i) & ":D" & MyYesRanges(i))) End If Next i MyFinalSelection.Copy 'Paste where you want them Range("Z2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub
AUTOFILL IN EXCEL MACRO
I am trying to use macro recorder in Excel to record a macro to fill down a column of cells, however because the fill down each time is a different number of cells it either fills down to short or too long and this seems to be because the macro identifies the cell range and its fixed. What I need is to auto populate or auto fill down from: ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[1],"" "",RC[2])" Range("C1").Select Selection.AutoFill Destination:=ActiveCell.Range("A1:A261") ActiveCell.Range("A1:A261").Select Since file is not always 261? How can I place a command to choose/autofill the last column? Blockquote Sub WMEHOT_Cleaner() ' ' WMEHOT_Cleaner Macro ' ' Columns("A:A").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("L:L").Select Selection.Cut Columns("B:B").Select ActiveSheet.Paste Columns("C:C").Select Selection.Cut Range("O1").Select ActiveSheet.Paste Range("C1").Select ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[1],"" "",RC[2])" Range("C1").Select Selection.AutoFill Destination:=ActiveCell.Range("A1:A261") ActiveCell.Range("A1:A261").Select Range("C1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Selection.End(xlUp).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("D:E").Select Selection.ClearContents Range("D1").Select ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[2],"" "",RC[6])" Range("D1").Select ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[5],""_"",RC[6])" Range("D1").Select Selection.AutoFill Destination:=ActiveCell.Range("A1:A261") ActiveCell.Range("A1:A261").Select ActiveCell.Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Selection.End(xlUp).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("I:J").Select Selection.ClearContents Columns("O:O").Select Selection.Cut Columns("E:E").Select ActiveSheet.Paste Columns("F:F").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("L:L").Select Selection.Cut Columns("J:J").Select ActiveSheet.Paste Range("J1").Select Selection.Copy Range("L1").Select ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select ActiveCell.FormulaR1C1 = "=""WMEOnline_""&RC[9]" Range("A1").Select Selection.AutoFill Destination:=ActiveCell.Range("A1:A261") ActiveCell.Range("A1:A261").Select ActiveCell.Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Selection.End(xlUp).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveCell.Offset(2, 0).Range("A1").Select Range("O5").Select Cells.Select Range("A1").Activate Selection.Copy Workbooks.Add ActiveSheet.Paste msgclean = MsgBox("Cleaning and Sorting Complete!!" & vbNewLine & "File Ready for LMS." & vbNewLine & "Please SAVE this file as CSV Format", vbInformation + vbOKOnly, "WME HOT Cleaner Template") End Sub
Use the following code: Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "=CONCATENATE(RC[1],"" "",RC[2])" Replace A if your column is not column A
Use lr = Cells(Rows.Count, "A").End(xlUp).Row to find the last row from a column or Set wks = ActiveWorkbook.Worksheets(sheet) i = wks.Range("A:A").End(xlDown).Row j = wks.Cells.End(xlToRight).Column to find the position of the last cell.
Filter data in a column and then count
I have recorded a macro to make changes to a sheet. Basically it makes a few changes such as add a column move two columns over and so forth. The thing that I am confused with is adding a small code to give me a count of the total DL and IDL in the MO REAL column L separately and putting the total count on another sheet in the same workbook "Resultados" in cells B17 and C17... Any ideas on how this can be accomplished? Here is the recorded code: Option Explicit Sub DefineDL_IDL() Dim wbTHMacro As Workbook, wsRegulares As Worksheet, wsRegularesDemitidos As Worksheet, wsTempActivos As Worksheet, _ wsTempJA As Worksheet, wsTempFit As Worksheet, wsTempDemitidos As Worksheet, wsPS As Worksheet, wsResultados As Worksheet, _ wsDLList As Worksheet, wssheet As Worksheet Sheets("Regulares").Select Columns("J:J").Select Selection.Insert Shift:=xlToRight Range("J1").Select ActiveCell.FormulaR1C1 = "MO REAL" Columns("K:K").Select Selection.Cut Columns("I:I").Select Selection.Insert Shift:=xlToRight Columns("Q:Q").Select Selection.Cut Columns("I:I").Select Selection.Insert Shift:=xlToRight Range("K1").Select Selection.AutoFilter ActiveSheet.Range("A:Z").AutoFilter Field:=11, Criteria1:= _ "INATIVE" Rows("5:5").Select Range("F5").Activate Range(Selection, Selection.End(xlDown)).Select Selection.Delete Shift:=xlUp ActiveSheet.Range("A:Z").AutoFilter Field:=11 Range("L2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'DL List'!RC[-11]:R[32]C[-10],2,0)" Range("L2").Select Selection.AutoFill Destination:=Range("L2:L5890") Range("L2:L5890").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("L2").Select ActiveSheet.Range("A:Z").AutoFilter Field:=11, Criteria1:="DL" ActiveSheet.Range("A:Z").AutoFilter Field:=12, Criteria1:="#N/A" Range("L23").Select ActiveCell.FormulaR1C1 = "DL" Range("L23").Select Selection.Copy Range("L25").Select Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Range("A:Z").AutoFilter Field:=12 Range("L4").Select ActiveSheet.Range("A:Z").AutoFilter Field:=11, Criteria1:=Array( _ "G&A", "MOH", "IDL", "Other MOH"), Operator:=xlFilterValues ActiveSheet.Range("A:Z").AutoFilter Field:=12, Criteria1:="#N/A" Range("L7").Select ActiveCell.FormulaR1C1 = "IDL" Range("L7").Select Selection.Copy Range("L15").Select Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Paste ActiveSheet.Paste Application.CutCopyMode = False Range("L7").Select ActiveWorkbook.Worksheets("Regulares").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("Regulares").AutoFilter.Sort.SortFields.Add Key:= _ Range("K1:K5890"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _ :=xlSortNormal ActiveSheet.Range("A:Z").AutoFilter Field:=12 Range("K2").Select ActiveSheet.Range("A:Z").AutoFilter Field:=11 Range("G2").Select ActiveCell.FormulaR1C1 = "1" Range("G2").Select Selection.Copy Range("J2").Select Range(Selection, Selection.End(xlDown)).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _ SkipBlanks:=False, Transpose:=False Range("J2").Select Application.CutCopyMode = False End Sub
If you are counting the times "DL" and "IDL" occur... 'Count DL and IDL count_DL = Application.WorksheetFunction.CountIf(ActiveSheet.Range("L:L"), "DL") count_IDL = Application.WorksheetFunction.CountIf(ActiveSheet.Range("L:L"), "IDL") 'Paste results in Resultados sheet Worksheets("Resultados").Range("B17") = count_DL Worksheets("Resultados").Range("C17") = count_IDL
Your question is a little confusing without understanding a broader picture of what you're doing. All you need to do to get a count and put it in another sheet is: Sheets("AnotherSheet").Range("B13") = Application.WorksheetFunction.CountA(Columns("G:G"))
Excel Macro generating single random output
I recorded a macro that runs through a bunch of formatting and splicing of data. It basically formats the data page, then splices it into months. The data roughly looks like this: Column A ... Column D ... Column H Column I Jan Feb ... Nov Dec - 00645 - budget 45.2 32.8 -15.0 100.00 Basically it fills in entries for all of column A (all entries are "LINE"), renames header on columns B, C, D, H, and I, then copys columns A-J and moves it to a tab created just for the specific month, then deletes column J so the next month will always be in column J and continues repeating till all months are parsed out. Its a pretty easy macro, mostly recorded, but its behaving strangely. The issue is that once it runs, it randomly inputs the value that is only supposed to be in column A ("LINE") to a single cell somewhere else in the file. It seems semi-random which cell it is. If you put in data from File A, no matter how many times you run the macro "LINE" will show up in the same cell. But it will be a different cell for Files B, C, D and so on. There is nothing fundamentially different about the cell it does this in when compared to the other cells (same entry, same formatting, etc). I have no idea why its doing this. Below is my code: Sub Format_Upload() Format_Upload Macro ActiveCell.FormulaR1C1 = "LINE" LastRow = Range("B" & Rows.Count).End(xlUp).Row Range("A2").Copy Range("A2").Resize(LastRow - 1) Range("B1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Dept ID" Range("C1").Select ActiveCell.FormulaR1C1 = "MSUPLOAD1" Range("D1").Select ActiveCell.FormulaR1C1 = "01/01/14" Range("I1").Select ActiveCell.FormulaR1C1 = "01/01/14" Range("D1").Select Selection.NumberFormat = "mm/dd/yy;#" Range("I1").Select Selection.NumberFormat = "mm/dd/yy;#" Cells.Select With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("J:U").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Selection.NumberFormat = "0.00" Columns("A:J").Select Selection.Copy Sheets("JAN").Select Range("A1").Select ActiveSheet.Paste Sheets("Data").Select Columns("J:J").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("FEB").Select Range("A1").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "2/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "2/1/2014" Range("H1").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("MAR").Select Range("A1").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "3/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "3/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("APR").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "4/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "4/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("A:J").Select Range("J1").Activate Selection.Copy Sheets("MAY").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "5/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "5/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("JUN").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "6/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "6/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("JUL").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "7/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "7/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("AUG").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "8/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "8/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Copy Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("SEP").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "9/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "9/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Selection.Copy Sheets("OCT").Select Sheets("Data").Select Columns("A:J").Select Application.CutCopyMode = False Selection.Copy Sheets("OCT").Select Range("A1").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "10/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "10/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("NOV").Select ActiveSheet.Paste Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "11/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "11/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("A:J").Select Selection.Copy Sheets("DEC").Select ActiveSheet.Paste Columns("D:D").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "12/1/2014" Range("I1").Select ActiveCell.FormulaR1C1 = "12/1/2014" Range("I2").Select Sheets("Data").Select Columns("J:J").Select Selection.Delete Shift:=xlToLeft Sheets("FEB").Select ActiveCell.FormulaR1C1 = "MSFEB" Sheets("MAR").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSMAR" Sheets("APR").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSAPR" Sheets("MAY").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSMAY" Sheets("JUN").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSJUN" Sheets("JUL").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSJUL" Sheets("AUG").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSAUG" Sheets("SEP").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSSEP" Sheets("OCT").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSOCT" Sheets("NOV").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSNOV" Sheets("DEC").Select Range("H1").Select ActiveCell.FormulaR1C1 = "MSDEC" Range("H2").Select End Sub I do not see anything in the code that explains this anomaly. Any ideas as to what's causing this issue? ' EDIT: The strange cell always appears on the first tab (named "JAN"), but its location varies.
ActiveCell.FormulaR1C1 = "LINE" This is putting "LINE" in whichever cell you have selected before running it. Change that to something else