FonzAre138
New Member
- Joined
- Dec 29, 2016
- Messages
- 10
I am stuck on this one. If I manually step through this macro it formats my date and formats two numeric columns to allow for leading zeros. When I just run the macro and have it do its thing it skips the formatting of the date and does not format the numeric columns for the leading zeros.
With this macro I am taking data on a worksheet, creating two new worksheets, and bringing in data into both of those worksheets from that main worksheet. They are named "OH" and "NY". I am selecting different columns for both new worksheets. The "OH" worksheet is where my date column is. Both worksheets have two separate numeric columns that I have to keep six positions long so I put in some logic to format them with "000000" positions for leading zeros.
Like I said, manually stepping through it I can follow it and see it format these columns. If I just start it and let it finish, the date and numeric formatting does not happen.
Any ideas or suggestions would be more than welcome at this point.
With this macro I am taking data on a worksheet, creating two new worksheets, and bringing in data into both of those worksheets from that main worksheet. They are named "OH" and "NY". I am selecting different columns for both new worksheets. The "OH" worksheet is where my date column is. Both worksheets have two separate numeric columns that I have to keep six positions long so I put in some logic to format them with "000000" positions for leading zeros.
Like I said, manually stepping through it I can follow it and see it format these columns. If I just start it and let it finish, the date and numeric formatting does not happen.
Code:
Sub States()
' Add extra worksheets and rename them.
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "OH"
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "NY"
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "OH Formula"
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "NY Formula"
Call OH
Call NY
' Hide the "OH Formula" and "NY Formula worksheets.
Sheets("OH Formula").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("NY Formula").Select
ActiveWindow.SelectedSheets.Visible = False
Range("E23").Select
Application.CutCopyMode = False
End Sub
‘Runs the calculations for OH People.
Sub OH()
‘ Select fields from the "States" worksheet for “OH” and add them to the "OH Formula" worksheet.
ErrorCount = Sheets("States").UsedRange.Rows.Count
RFCount = 1
For RCount = 1 To ErrorCount
If Sheets("States").Cells(RCount, "P") = "OH"
Then
Sheets("OH Formula").Cells(RFCount, "I") = Sheets("States").Cells(RCount, "D")
Sheets("OH Formula").Cells(RFCount, "K") = Sheets("States").Cells(RCount, "G")
Sheets("OH Formula").Cells(RFCount, "J") = Sheets("States").Cells(RCount, "H")
Sheets("OH Formula").Cells(RFCount, "M") = Sheets("States").Cells(RCount, "J")
Sheets("OH Formula").Cells(RFCount, "L") = Sheets("States").Cells(RCount, "L")
RFCount = RFCount + 1
End If
Next Rcount
' Concatenate the strings to check for duplicate records.
Sheets("OH Formula").Activate
Range("P1").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-7],"","",RC[-6],"","",RC[-5],"","",RC[-4],"","",RC[-3])"
' Autofill CONCATENATE selection down 1000 rows to cover max data rows.
Range("P1").Select
Selection.AutoFill Destination:=Range("P1:P1000"), Type:=xlFillDefault
Range("P1:P1000").Select
' Copy and Paste Values to turn concatenated fields from formula to string.
Columns("P:P").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Remove duplicate records.
Columns("P:P").Select
Application.CutCopyMode = False
ActiveSheet.Range("$P$1:$P$1000").RemoveDuplicates Columns:=1, Header:=xlNo
Range("R16").Select
Sheets("OH Formula").Select
' Select Text to Columns to break the concatenated string back into separate cells.
Columns("P:P").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
' Pull in values from the "OH Formula" worksheet onto the “OH” worksheet by column.
CopyRateCount = Sheets("OH Formula").UsedRange.Rows.Count
CRCount2 = 4
For CRCount = 1 To CopyRateCount
Sheets("OH").Cells(CRCount2, "B") = Sheets("OH Formula").Cells(CRCount, "A")
Sheets("OH").Cells(CRCount2, "C") = Sheets("OH Formula").Cells(CRCount, "B")
Sheets("OH").Cells(CRCount2, "D") = Sheets("OH Formula").Cells(CRCount, "C")
Sheets("OH").Cells(CRCount2, "E") = Sheets("OH Formula").Cells(CRCount, "D")
Sheets("OH").Cells(CRCount2, "F") = Sheets("OH Formula").Cells(CRCount, "E")
CRCount2 = CRCount2 + 1
Next CRCount
' Format the “Date” column.
Range("B4:B1000").Select
Selection.NumberFormat = "mm/dd/yyyy"
' Change the “ID” and “Number” columns into six positions to account for leading zeros.
Range("D4:E1000").Select
Range("E1000").Activate
Selection.NumberFormat = "000000"
' Copy and Paste Values on the "OH" worksheet to change from formula to string.
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H8").Select
Application.CutCopyMode = False
End Sub
'Runs the calculations on NY People.
Sub NY()
' Select fields from the "States" worksheet for “NY” and add them to the "NY Formula" worksheet.
ErrorCount = Sheets("States").UsedRange.Rows.Count
RFCount = 1
For RCount = 1 To ErrorCount
If Sheets("States").Cells(RCount, "P") = "NY"
Then
Sheets("NY Formula").Cells(RFCount, "J") = Sheets("States").Cells(RCount, "G")
Sheets("NY Formula").Cells(RFCount, "I") = Sheets("States").Cells(RCount, "I")
Sheets("NY Formula").Cells(RFCount, "M") = Sheets("States").Cells(RCount, "J")
Sheets("NY Formula").Cells(RFCount, "L") = Sheets("States").Cells(RCount, "K")
Sheets("NY Formula").Cells(RFCount, "K") = Sheets("States").Cells(RCount, "L")
RFCount = RFCount + 1
End If
Next RCount
' Concatenate the strings to check for duplicate records.
Sheets("NY Formula").Activate
Range("P1").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-7],"","",RC[-6],"","",RC[-5],"","",RC[-4],"","",RC[-3])"
' Autofill CONCATENATE selection down 1000 rows to cover max number of data rows.
Range("P1").Select
Selection.AutoFill Destination:=Range("P1:P1000"), Type:=xlFillDefault
Range("P1:P1000").Select
' Copy and Paste the concatenated formula to a string.
Columns("P:P").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2").Select
Application.CutCopyMode = False
' Remove the duplicate records.
Columns("P:P").Select
ActiveSheet.Range("$P$1:$P$1000").RemoveDuplicates Columns:=1, Header:=xlNo
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
TrailingMinusNumbers:=True
' Pull data into the "NY" worksheet from "NY Formula by column."
CopyRateCount = Sheets("NY Formula").UsedRange.Rows.Count
CRCount2 = 4
For CRCount = 1 To CopyRateCount
Sheets("NY").Cells(CRCount2, "B") = Sheets("NY Formula").Cells(CRCount, "A")
Sheets("NY").Cells(CRCount2, "C") = Sheets("NY Formula").Cells(CRCount, "B")
Sheets("NY").Cells(CRCount2, "D") = Sheets("NY Formula").Cells(CRCount, "C")
Sheets("NY").Cells(CRCount2, "E") = Sheets("NY Formula").Cells(CRCount, "D")
Sheets("NY").Cells(CRCount2, "F") = Sheets("NY Formula").Cells(CRCount, "E")
CRCount2 = CRCount2 + 1
Next CRCount
' Change Source and Destination columns to be six positions for leading zeros.
Range("C4:D1000").Select
Range("D1000").Activate
Selection.NumberFormat = "000000"
' Copy and Paste Values to turn from formula to string.
Cells.Select
Range("H8").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H12").Select
Application.CutCopyMode = False
End Sub
Any ideas or suggestions would be more than welcome at this point.