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