Coding help for a complete VBA Beginner

[apini]

Hello!

Preface this, I'm a complete beginner. I know I desperately need to take a course but I do want to get this one program running fully sooner than later.

I have a very basic program I run right now to move data from a pivot table into our import spreadsheet. It has various heads in Row 3 (Date, Description, Unit, Rate, etc) that need to be reformatted. Due to the nature of how we use this the column that those headers fall into may change based on whether we have to add or remove fields from the pivot. For example some clients are invoiced based on PO# only while others need to be broken down further by PO# and WO# which causes all columns to shift one.

What I want to do: I want to find the header (eg Date) and format all cells beneath it up to approx row 1000 in YYYY/MM/DD format. I want to do similar to Rate and Revenue into Currency format. I need my code to find the header, select ~1000 rows beneath it, reformat it. I only need specific fields formatted.


Sub Pivot_to_Range()
Application.ScreenUpdating = False
Application.Calculation = xlManual
'Clear old data in import
Worksheets("IMPORT SHEET").Range("A3:AA1000").ClearContents
'Copy Cust# to import sheet
Worksheets("PIVOT TABLE").Select
Range("H1").Copy
Worksheets("IMPORT SHEET").Select
Range("B1").PasteSpecial Paste:=xlPasteValues
'Copy from pivot headers to import headers
Worksheets("PIVOT TABLE").Select
Range("A3:AA3").Copy
Worksheets("IMPORT SHEET").Select
Range("A3").PasteSpecial Paste:=xlPasteValues
'Copy from pivot to import
Worksheets("PIVOT TABLE").Select
Range("A4:AA450").Copy
Worksheets("IMPORT SHEET").Select
Range("A5").PasteSpecial Paste:=xlPasteValues
'Find headers and reformat steps here...
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

[georgiboy]

Hi apini,

Welcome to the forum.

Give the below a try, you can adjust the resize 1000 part to be the amount of rows you want to format under the header. You can change the header it is looking for just after the '.Find(' part inside the ""

Sub Pivot_to_Range() Dim wsImp As Worksheet, wsPiv As Worksheet

Set wsImp = Worksheets("IMPORT SHEET")
Set wsPiv = Worksheets("PIVOT TABLE")

Application.ScreenUpdating = False
Application.Calculation = xlManual

'Clear old data in import
wsImp.Range("A3:AA1000").ClearContents
'Copy Cust# to import sheet
wsPiv.Range("H1").Copy
wsImp.Range("B1").PasteSpecial xlPasteValues
'Copy from pivot headers to import headers
wsPiv.Range("A3:AA3").Copy
wsImp.Range("A3").PasteSpecial xlPasteValues
'Copy from pivot to import
wsPiv.Range("A4:AA450").Copy
wsImp.Range("A5").PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Find headers and reformat steps here...

With wsImp.Range("A3:AA3")
.Find("Date").Offset(1, 0).Resize(1000, 1).NumberFormat = "yyyy/mm/dd"
.Find("Rate").Offset(1, 0).Resize(1000, 1).NumberFormat = "$#,##0.00"
.Find("Revenue").Offset(1, 0).Resize(1000, 1).NumberFormat = "$#,##0.00"
End With

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub




As a side note: unless your spreadsheet is set up with rigid ranges we can find the last row with data present - this means we can copy only where data exists and not just a block of data and empty cells.

Hope this helps