Algorithm to change format of specific cells

[Dave32]

All,

I am running VBA code in a loop to copy data from two worksheets into a third workspread and display data in a row.

The problem I have is I need to import the data in to Access. Big issue the format of specific cells is incorrect. I need to add to my existing code to change the cell format: e.g Number, Percentage, Text.

My existing code is:

Private Sub CommandButton1_Click()

Dim R As Long
With Sheet4
R = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(R, 1).Value = Sheet3.Cells(81, 5).Value 'MS Marketing Activity Name
.Cells(R, 2).Value = Sheet3.Cells(84, 2).Value 'Target Product
.Cells(R, 3).Value = Sheet3.Cells(84, 4).Value 'MS Activity Description
.Cells(R, 4).Value = Sheet3.Cells(84, 9).Value 'GTM/Initiative
.Cells(R, 5).Value = Sheet3.Cells(84, 11).Value 'P & L
.Cells(R, 6).Value = Sheet3.Cells(84, 13).Value 'P & L Amount
.Cells(R, 7).Value = Sheet3.Cells(86, 2).Value '3rd Party Vendor Name
.Cells(R, 8).Value = Sheet3.Cells(86, 4).Value '3rd Party Vendor ID
.Cells(R, 9).Value = Sheet3.Cells(86, 9).Value 'IO Number
.Cells(R, 10).Value = Sheet3.Cells(86, 11).Value 'POE due date to MS
.Cells(R, 11).Value = Sheet3.Cells(90, 2).Value 'AOF Jul
.Cells(R, 12).Value = Sheet3.Cells(90, 3).Value 'AOF Aug
.Cells(R, 13).Value = Sheet3.Cells(90, 4).Value 'AOF Sept
.Cells(R, 14).Value = Sheet3.Cells(90, 5).Value 'AOF Oct
.Cells(R, 15).Value = Sheet3.Cells(90, 6).Value 'AOF Nov
.Cells(R, 16).Value = Sheet3.Cells(90, 7).Value 'AOF Dec
.Cells(R, 17).Value = Sheet3.Cells(90, 9).Value 'AOF Jan
.Cells(R, 18).Value = Sheet3.Cells(90, 10).Value 'AOF Feb
.Cells(R, 19).Value = Sheet3.Cells(90, 11).Value 'AOF Mar
.Cells(R, 20).Value = Sheet3.Cells(90, 12).Value 'AOF Apr
.Cells(R, 21).Value = Sheet3.Cells(90, 13).Value 'AOF May
.Cells(R, 22).Value = Sheet3.Cells(90, 14).Value 'AOF Jun
.Cells(R, 23).Value = Sheet3.Cells(13, 2).Value 'MS Campaign Name
.Cells(R, 24).Value = Sheet3.Cells(16, 2).Value 'MS Campaign Owner
.Cells(R, 25).Value = Sheet3.Cells(19, 2).Value 'Budget Source
.Cells(R, 26).Value = Sheet3.Cells(25, 2).Value 'Targeted GEO (A13)
.Cells(R, 27).Value = Sheet3.Cells(28, 2).Value 'MS Budget Owner
.Cells(R, 28).Value = Sheet3.Cells(10, 9).Value 'Campaign Description (Summary)
.Cells(R, 29).Value = Sheet3.Cells(14, 9).Value 'Campaign Description(Detailed)
.Cells(R, 30).Value = Sheet3.Cells(36, 2).Value 'MS Funds -Client
.Cells(R, 31).Value = Sheet3.Cells(36, 5).Value 'MS Funds - IW
.Cells(R, 32).Value = Sheet3.Cells(38, 2).Value 'MS Funds- Server
.Cells(R, 33).Value = Sheet3.Cells(51, 2).Value 'Metric1
.Cells(R, 34).Value = Sheet3.Cells(51, 6).Value 'Metric1 Description
.Cells(R, 35).Value = Sheet3.Cells(51, 12).Value 'Metric1 Goal
.Cells(R, 36).Value = Sheet3.Cells(52, 2).Value 'Metric2
.Cells(R, 37).Value = Sheet3.Cells(52, 6).Value 'Metric2 Description
.Cells(R, 38).Value = Sheet3.Cells(52, 12).Value 'Metric2 Goal
.Cells(R, 39).Value = Sheet3.Cells(53, 2).Value 'Metric3
.Cells(R, 40).Value = Sheet3.Cells(53, 6).Value 'Metric3 Description
.Cells(R, 41).Value = Sheet3.Cells(53, 12).Value 'Metric3 Goal
.Cells(R, 42).Value = Sheet3.Cells(54, 2).Value 'Metric4
.Cells(R, 43).Value = Sheet3.Cells(54, 6).Value 'Metric4 Description
.Cells(R, 44).Value = Sheet3.Cells(54, 12).Value 'Metric4 Goal
.Cells(R, 45).Value = Sheet3.Cells(55, 2).Value 'Metric5
.Cells(R, 46).Value = Sheet3.Cells(55, 6).Value 'Metric5 Description
.Cells(R, 47).Value = Sheet3.Cells(55, 12).Value 'Metric 5 Goal
.Cells(R, 48).Value = Sheet3.Cells(61, 7).Value 'Business Decision Maker % Spend
.Cells(R, 49).Value = Sheet3.Cells(62, 7).Value 'Developer % Spend
.Cells(R, 50).Value = Sheet3.Cells(63, 7).Value 'Home PC Users % Spend
.Cells(R, 51).Value = Sheet3.Cells(64, 7).Value 'Information Workers % Spend
.Cells(R, 52).Value = Sheet3.Cells(65, 7).Value 'IT Professional % Spend
.Cells(R, 53).Value = Sheet3.Cells(66, 7).Value 'Partners % Spend
.Cells(R, 54).Value = Sheet3.Cells(61, 13).Value 'Academic % Spend
.Cells(R, 55).Value = Sheet3.Cells(62, 13).Value 'Consumer % Spend
.Cells(R, 56).Value = Sheet3.Cells(63, 13).Value 'Enterprise % Spend
.Cells(R, 57).Value = Sheet3.Cells(64, 13).Value 'Government % Spend
.Cells(R, 58).Value = Sheet3.Cells(65, 13).Value 'Mid-market % Spend
.Cells(R, 59).Value = Sheet3.Cells(66, 13).Value 'Small Business % Spend
.Cells(R, 60).Value = Sheet3.Cells(70, 2).Value 'Marketing Mix1
.Cells(R, 61).Value = Sheet3.Cells(71, 2).Value 'Marketing Mix2
.Cells(R, 62).Value = Sheet3.Cells(72, 2).Value 'Marketing Mix3
.Cells(R, 63).Value = Sheet3.Cells(73, 2).Value 'Marketing Mix4
.Cells(R, 64).Value = Sheet3.Cells(74, 2).Value 'Marketing Mix5
.Cells(R, 65).Value = Sheet3.Cells(75, 2).Value 'Marketing Mix6
.Cells(R, 66).Value = Sheet3.Cells(70, 7).Value 'Marketing Mix % Spend1
.Cells(R, 67).Value = Sheet3.Cells(71, 7).Value 'Marketing Mix % Spend2
.Cells(R, 68).Value = Sheet3.Cells(72, 7).Value 'Marketing Mix % Spend3
.Cells(R, 69).Value = Sheet3.Cells(73, 7).Value 'Marketing Mix % Spend4
.Cells(R, 70).Value = Sheet3.Cells(74, 7).Value 'Marketing Mix % Spend5
.Cells(R, 71).Value = Sheet3.Cells(75, 7).Value 'Marketing Mix % Spend6
.Cells(R, 72).Value = Sheet2.Cells(15, 2).Value 'Dell Alliance Manager
.Cells(R, 73).Value = Sheet2.Cells(13, 2).Value '% MS Funded
.Cells(R, 74).Value = Sheet2.Cells(36, 2).Value 'Total PFR Amount
.Cells(R, 75).Value = Sheet2.Cells(2, 2).Value 'PFR Name
.Cells(R, 76).Value = Sheet2.Cells(4, 2).Value 'Dell Activity Name
.Cells(R, 77).Value = Sheet2.Cells(19, 4).Value 'Objectives
.Cells(R, 78).Value = Sheet2.Cells(5, 2).Value 'Region
.Cells(R, 79).Value = Sheet2.Cells(7, 2).Value 'Dell Segment
.Cells(R, 80).Value = Sheet2.Cells(6, 5).Value 'Target Number of Customers:
.Cells(R, 81).Value = Sheet2.Cells(7, 5).Value 'Response Rate Forecast:
.Cells(R, 82).Value = Sheet2.Cells(8, 5).Value 'Conversion Rate Forecast:
.Cells(R, 83).Value = Sheet2.Cells(9, 5).Value 'Incremental Number of Systems:
.Cells(R, 84).Value = Sheet2.Cells(10, 5).Value 'Incremental Microsoft Revenue:
.Cells(R, 85).Value = Sheet2.Cells(11, 5).Value 'ROI:
.Cells(R, 86).Value = Sheet2.Cells(12, 5).Value 'Circulation:
.Cells(R, 87).Value = Sheet2.Cells(13, 5).Value 'Impressions:
.Cells(R, 88).Value = Sheet2.Cells(14, 5).Value 'Traffic Forecast:
.Cells(R, 89).Value = Sheet2.Cells(15, 5).Value 'Web Traffic/month:
.Cells(R, 90).Value = Sheet2.Cells(17, 2).Value 'Dell Regional/Segment Finance Contact
.Cells(R, 91).Value = Sheet2.Cells(19, 2).Value 'Dell MPO/HQ Contact
.Cells(R, 92).Value = Sheet2.Cells(24, 2).Value 'PFR July Invoice Amount
.Cells(R, 93).Value = Sheet2.Cells(25, 2).Value 'PFR August Invoice Amount
.Cells(R, 94).Value = Sheet2.Cells(26, 2).Value 'PFR September Invoice Amount
.Cells(R, 95).Value = Sheet2.Cells(27, 2).Value 'PFR October Invoice Amount
.Cells(R, 96).Value = Sheet2.Cells(28, 2).Value 'PFR November Invoice Amount
.Cells(R, 97).Value = Sheet2.Cells(29, 2).Value 'PFR December Invoice Amount
.Cells(R, 98).Value = Sheet2.Cells(30, 2).Value 'PFR January Invoice Amount
.Cells(R, 99).Value = Sheet2.Cells(31, 2).Value 'PFR February Invoice Amount
.Cells(R, 100).Value = Sheet2.Cells(32, 2).Value 'PFR March Invoice Amount
.Cells(R, 101).Value = Sheet2.Cells(33, 2).Value 'PFR April Invoice Amount
.Cells(R, 102).Value = Sheet2.Cells(34, 2).Value 'PFR May Invoice Amount
.Cells(R, 103).Value = Sheet2.Cells(35, 2).Value 'PFR June Invoice Amount



'etc

End With
End Sub

[Leith Ross]

Hello Dave32,

Please use the code tags to wrap your code.

Sincerely,
Leith Ross

[Kuskush]

I guess that the respective cells in the source worksheets (sheet2 &sheet3) are formatted accordingly.
Then just Copy/Paste the code and replace .Value by .NumberFormat in the copy.

.Cells(R, 48).Value = Sheet3.Cells(61, 7).Value 'Business Decision Maker % Spend
.Cells(R, 48).NumberFormat = Sheet3.Cells(61, 7).NumberFormat 'Business Decision Maker % Spend

If not,

'columns with percentage
columns(48).numberformat="0.0%"
'columns with text
columns(3).numberformat="@"
'columns with numbers
columns(3).numberformat="0.000"
' and so on

Regards

[Leith Ross]

Hello Dave32,

I am locking this post because you have not complied my request to added the code tags. If you had any questions about how to do it, you should have said so. Please re-read the forum rules and contact me by private message when you agree to uphold the rules as member of this forum.

Sincerely,
Leith Ross