Sub ExportDataToSS()
Dim currentSheet As Worksheet
Dim newWorkbook As Workbook
Dim rawDataSheet As Worksheet
Dim toSSSheet As Worksheet
Dim Calculations2 As Worksheet
Dim lastRow As Long
Dim i As Long
Dim emptyRow As Long
Dim consecutiveEmpty As Long
Dim lastMonthName As String
Dim lastMonthYear As String
' Task 1: Name this macro "Export Data to SS"
' Task 2: Define the current sheet as the ActiveSheet
Set currentSheet = ActiveSheet
' Define the sheet "Calculation" in the workbook as "Calculation"
Dim calculationSheet As Worksheet
Set calculationSheet = ThisWorkbook.Sheets("Calculation")
' Task 3: Create a new Excel workbook
Set newWorkbook = Workbooks.Add
' Task 4: Create three sheets in the new Excel workbook
Set rawDataSheet = newWorkbook.Sheets.Add(After:=newWorkbook.Sheets(newWorkbook.Sheets.Count))
rawDataSheet.Name = "raw data"
Set toSSSheet = newWorkbook.Sheets.Add(After:=rawDataSheet)
toSSSheet.Name = "To SS"
Set calculations2Sheet = newWorkbook.Sheets.Add(After:=toSSSheet)
calculations2Sheet.Name = "Calculations2"
' Task 5: Align all cells in the new sheets of Task 5 left
rawDataSheet.Cells.HorizontalAlignment = xlLeft
toSSSheet.Cells.HorizontalAlignment = xlLeft
calculations2Sheet.Cells.HorizontalAlignment = xlLeft
' Task 6: Copy data from ActiveSheet to "raw data" and from "Calculation" to "Calculations2" as values without format
currentSheet.UsedRange.Copy
rawDataSheet.Range("A1").PasteSpecial xlPasteValues
calculationSheet.UsedRange.Copy
calculations2Sheet.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False ' Clear the clipboard
' Task 7: Type headers in the first cells of column A until H of the sheet "To SS"
toSSSheet.Range("A1").Value = "campaign_external_id"
toSSSheet.Range("B1").Value = "amount"
toSSSheet.Range("C1").Value = "received"
toSSSheet.Range("D1").Value = "record_type"
toSSSheet.Range("E1").Value = "contribution_type"
toSSSheet.Range("F1").Value = "notes"
toSSSheet.Range("G1").Value = "currency"
toSSSheet.Range("H1").Value = "donor_person_id"
' Task 8: Format the data in column B of "To SS" as currency and use the symbol $
toSSSheet.Range("B:B").NumberFormat = "$#,##0.00"
' Task 9: Copy data from column C of "raw data" and their corresponding cells in column P of "raw data"
' Only copy data if the corresponding cells in column P are not 0 or 0.00
lastRow = rawDataSheet.Cells(Rows.Count, "C").End(xlUp).Row
emptyRow = 2 ' Start row in "To SS" sheet
For i = 4 To lastRow
If rawDataSheet.Cells(i, "P").Value <> 0 Then
toSSSheet.Cells(emptyRow, "A").Value = rawDataSheet.Cells(i, "C").Value
toSSSheet.Cells(emptyRow, "B").Value = -rawDataSheet.Cells(i, "P").Value
toSSSheet.Cells(emptyRow, "F").Value = "Ministry Compensation of " & Format(DateAdd("m", -1, Date), "mmmm yyyy")
emptyRow = emptyRow + 1
End If
Next i
' Task 10: Copy data from column J of "raw data" and their corresponding cells in column K of "raw data"
' Only copy data if the corresponding cells in column K are not 0 or 0.00 or empty
consecutiveEmpty = 0
For i = 4 To lastRow
If consecutiveEmpty >= 100 Then Exit For ' Stop after 100 consecutive empty cells
If Not IsEmpty(rawDataSheet.Cells(i, "K").Value) And rawDataSheet.Cells(i, "K").Value <> 0 Then
toSSSheet.Cells(emptyRow, "A").Value = rawDataSheet.Cells(i, "J").Value
toSSSheet.Cells(emptyRow, "B").Value = -rawDataSheet.Cells(i, "K").Value
toSSSheet.Cells(emptyRow, "F").Value = "Ministry Related Expenses of " & Format(DateAdd("m", -1, Date), "mmmm yyyy")
emptyRow = emptyRow + 1
consecutiveEmpty = 0
Else
consecutiveEmpty = consecutiveEmpty + 1
End If
Next i
' Task 11: Copy data from column C of "raw data" and their corresponding cells in column G and S
' Only copy data if the corresponding cells in column G are not 0 or 0.00 or empty
consecutiveEmpty = 0
For i = 4 To lastRow
If consecutiveEmpty >= 100 Then Exit For ' Stop after 100 consecutive empty cells
If Not IsEmpty(rawDataSheet.Cells(i, "G").Value) And rawDataSheet.Cells(i, "G").Value <> 0 Then
toSSSheet.Cells(emptyRow, "A").Value = rawDataSheet.Cells(i, "C").Value
toSSSheet.Cells(emptyRow, "B").Value = -rawDataSheet.Cells(i, "G").Value
toSSSheet.Cells(emptyRow, "F").Value = "Adjustment - " & rawDataSheet.Cells(i, "S").Value
emptyRow = emptyRow + 1
consecutiveEmpty = 0
Else
consecutiveEmpty = consecutiveEmpty + 1
End If
Next i
' Task 12: Copy data from column C of "raw data" and their corresponding cells in column F and S
' Only copy data if the corresponding cells in column F are not 0 or 0.00 or empty
consecutiveEmpty = 0
For i = 4 To lastRow
If consecutiveEmpty >= 100 Then Exit For ' Stop after 100 consecutive empty cells
If Not IsEmpty(rawDataSheet.Cells(i, "F").Value) And rawDataSheet.Cells(i, "F").Value <> 0 Then
toSSSheet.Cells(emptyRow, "A").Value = rawDataSheet.Cells(i, "C").Value
toSSSheet.Cells(emptyRow, "B").Value = -rawDataSheet.Cells(i, "F").Value
toSSSheet.Cells(emptyRow, "F").Value = "Adjustment - " & rawDataSheet.Cells(i, "S").Value
emptyRow = emptyRow + 1
consecutiveEmpty = 0
Else
consecutiveEmpty = consecutiveEmpty + 1
End If
Next i
' Task 13: In column C of "To SS" type the last day of the last month. Format as M/D/YY.
lastMonthName = Format(DateAdd("m", -1, Date), "mmmm")
lastMonthYear = Format(DateAdd("m", -1, Date), "yyyy")
toSSSheet.Range("C2:C" & emptyRow - 1).Value = DateSerial(CInt(lastMonthYear), Month(Date), 0)
toSSSheet.Range("C2:C" & emptyRow - 1).NumberFormat = "m/d/yy"
' Task 14: In column D of "To SS" type "ledger"
toSSSheet.Range("D2:D" & emptyRow - 1).Value = "ledger"
' Task 15: In column E of "To SS" type "Expense"
toSSSheet.Range("E2:E" & emptyRow - 1).Value = "Expense"
' Task 16: In column G of "To SS" type "USD"
toSSSheet.Range("G2:G" & emptyRow - 1).Value = "USD"
' Task 17: Copy data from column T of "Calculations2" and their corresponding cells in column V of "Calculations2"
' Only copy data if the corresponding cells in column V are not 0 or 0.00
lastRow = rawDataSheet.Cells(Rows.Count, "T").End(xlUp).Row
emptyRow = 2 ' Start row in "To SS" sheet
For i = 2 To lastRow
If rawDataSheet.Cells(i, "V").Value <> 0 Then
toSSSheet.Cells(emptyRow, "A").Value = rawDataSheet.Cells(i, "T").Value
toSSSheet.Cells(emptyRow, "B").Value = -rawDataSheet.Cells(i, "V").Value
toSSSheet.Cells(emptyRow, "F").Value = "Administration Fees of " & Format(DateAdd("m", -1, Date), "mmmm yyyy")
emptyRow = emptyRow + 1
End If
Next i
' Task 18: Copy data from column T of "Calculations2" and their corresponding cells in column W of "Calculations2"
' Only copy data if the corresponding cells in column W are not 0 or 0.00
lastRow = rawDataSheet.Cells(Rows.Count, "T").End(xlUp).Row
emptyRow = 2 ' Start row in "To SS" sheet
For i = 2 To lastRow
If rawDataSheet.Cells(i, "W").Value <> 0 Then
toSSSheet.Cells(emptyRow, "A").Value = rawDataSheet.Cells(i, "T").Value
toSSSheet.Cells(emptyRow, "B").Value = -rawDataSheet.Cells(i, "W").Value
toSSSheet.Cells(emptyRow, "F").Value = "Credit Card Fees of " & Format(DateAdd("m", -1, Date), "mmmm yyyy")
emptyRow = emptyRow + 1
End If
Next i
' Task 19:
Dim cellValue As String
For Each cell In toSSSheet.Range("A:A")
If Len(cell.Value) > 0 Then
cellValue = cell.Value
cellValue = Replace(cellValue, "[", "")
cellValue = Replace(cellValue, "]", "")
cell.Value = cellValue
End If
Next cell
' Task 20:
For Each cell In toSSSheet.Range("A2:A" & emptyRow - 1)
If Len(cell.Value) > 0 Then
cellValue = cell.Value
cellValue = Left(cellValue, 3)
cell.Value = cellValue
End If
Next cell
' Task 21: Delete all sheets in the "To SS" workbook
Dim sheet As Worksheet
Application.DisplayAlerts = False ' Disable alerts to avoid confirmation prompt
For Each sheet In newWorkbook.Sheets
If sheet.Name <> "To SS" Then
sheet.Delete
End If
Next sheet
' Task 22: Rename the "To SS" sheet to "Sheet 1"
toSSSheet.Name = "Sheet1"
Application.DisplayAlerts = True ' Enable alerts
' Cleanup
Application.CutCopyMode = False
Set currentSheet = Nothing
Set newWorkbook = Nothing
Set rawDataSheet = Nothing
Set toSSSheet = Nothing
End Sub
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks