pawcoyote
07-28-2017, 12:10 PM
Howdy,
I am not sure what is wrong with this code. I have two spreadsheets on one I enter costs in the accounting format with four (4) decimal places. There is a copy cells option that we use but when it copies the contents of the cell from one worksheet to the other it does not bring over the formatting and it changes the number. i.e. 0.0123 I enter and when it gets copied it goes to 0.0100 or I enter 0.0095 when it is copied it goes to 0.0100 as well.
I have made bold the two lines that are the ones I am having issues with.
The Green box has the cells we enter the data in and the Gray box has what it looks like when it copies over..
1991919920
Option Explicit
Sub BuildMOST()
Dim i As Long
Dim iCol As Long
Set wsMDS = Worksheets("MDS Equipment Detail")
Set wsMOST = Worksheets("Most Equipment ADD")
Set headerMDS = wsMDS.Rows(rowHeaderMDS)
Set headerMOST = wsMOST.Rows(rowHeaderMOST)
Application.ScreenUpdating = False
'get last Client Name row
Set wsMDS = Worksheets("MDS Equipment Detail")
Set headerMDS = wsMDS.Rows(rowHeaderMDS)
'get last Client Name row
iCol = GetColumnNumber("Client Name", headerMDS)
With wsMDS
rowDataEndMDS = .Cells(.Rows.Count, iCol).End(xlUp).Row
End With
'added 3/21/2017
If rowDataEndMDS < 7 Then
MsgBox "No Data on MDS to copy to MOST"
Exit Sub
End If
Set rMDS = wsMDS.Rows(rowDataStartMDS).Resize(rowDataEndMDS - rowDataStartMDS + 1)
Range(wsMOST.Rows(rowDataStartMOST), wsMOST.Rows(rowDataEndMDS)).EntireRow.Delete
For i = rowDataStartMDS To rowDataEndMDS
With wsMOST.Rows(i - 2)
' LUV(headerMOST, "Config Serial Number" & vbLf & "Manufacturer serial if no Configured serial", i - 2).Value = LUV(headerMDS, "Oracle Configuration SN", i).Value
.Cells(1).Value = LUV(headerMDS, "Oracle Configuration SN", i).Value
.Cells(2).Value = LUV(headerMDS, "Service Resource", i).Value
.Cells(3).Value = LUV(headerMDS, "Oracle Project Code", i).Value
.Cells(10).Value = LUV(headerMDS, "Location Street Address", i).Value & " " & LUV(headerMDS, "Location City", i).Value & " " & LUV(headerMDS, "Location State", i).Value & " " & LUV(headerMDS, "Location Zip", i).Text
.Cells(12).Value = LUV(headerMDS, "Cost Center (if required)", i).Value
.Cells(13).Value = LUV(headerMDS, "Department Name (if required)", i).Value
.Cells(14).Value = LUV(headerMDS, "Contract Effective Date", i).Value
.Cells(15).Value = LUV(headerMDS, "Account Entitlements (Service or Supplies or Both or Monitor Only)", i).Value
.Cells(18).Value = LUV(headerMDS, "Contract Effective Date", i).Value
.Cells(19).Value = LUV(headerMDS, "B&W Total Meter", i).Value
.Cells(25).Value = LUV(headerMDS, "BW Supplies Overage Rate", i).Value
.Cells(26).Value = LUV(headerMDS, "Color Total Meter", i).Value
.Cells(29).Value = LUV(headerMDS, "Color Supplies Overage Rate", i).Value
.Cells(30).Value = LUV(headerMDS, "Contract Effective Date", i).Value
.Cells(39).Value = LUV(headerMDS, "First Name", i).Value & " " & LUV(headerMDS, "Last Name", i).Value
.Cells(40).Value = LUV(headerMDS, "Phone", i).Value
.Cells(41).Value = LUV(headerMDS, "E-mail", i).Value
.Cells(43).Value = LUV(headerMDS, "Location Street Address", i).Value & " " & LUV(headerMDS, "Location City", i).Value & " " & LUV(headerMDS, "Location State", i).Value & " " & LUV(headerMDS, "Location Zip", i).Text
.Cells(44).Value = LUV(headerMDS, "Mfg", i).Value
.Cells(45).Value = LUV(headerMDS, "Oracle VPN (Item Number)", i).Value
.Cells(46).Value = LUV(headerMDS, "Ricoh Equipment ID", i).Value
.Cells(47).Value = LUV(headerMDS, "Serial Number", i).Value
End With
Next i
Application.ScreenUpdating = True
MsgBox "The data has been copied to the MOST Equipment Add worksheet. Please verify that the data has copied over properly!" ' 5/9/17 Fixed spelling
End Sub
I am not sure what is wrong with this code. I have two spreadsheets on one I enter costs in the accounting format with four (4) decimal places. There is a copy cells option that we use but when it copies the contents of the cell from one worksheet to the other it does not bring over the formatting and it changes the number. i.e. 0.0123 I enter and when it gets copied it goes to 0.0100 or I enter 0.0095 when it is copied it goes to 0.0100 as well.
I have made bold the two lines that are the ones I am having issues with.
The Green box has the cells we enter the data in and the Gray box has what it looks like when it copies over..
1991919920
Option Explicit
Sub BuildMOST()
Dim i As Long
Dim iCol As Long
Set wsMDS = Worksheets("MDS Equipment Detail")
Set wsMOST = Worksheets("Most Equipment ADD")
Set headerMDS = wsMDS.Rows(rowHeaderMDS)
Set headerMOST = wsMOST.Rows(rowHeaderMOST)
Application.ScreenUpdating = False
'get last Client Name row
Set wsMDS = Worksheets("MDS Equipment Detail")
Set headerMDS = wsMDS.Rows(rowHeaderMDS)
'get last Client Name row
iCol = GetColumnNumber("Client Name", headerMDS)
With wsMDS
rowDataEndMDS = .Cells(.Rows.Count, iCol).End(xlUp).Row
End With
'added 3/21/2017
If rowDataEndMDS < 7 Then
MsgBox "No Data on MDS to copy to MOST"
Exit Sub
End If
Set rMDS = wsMDS.Rows(rowDataStartMDS).Resize(rowDataEndMDS - rowDataStartMDS + 1)
Range(wsMOST.Rows(rowDataStartMOST), wsMOST.Rows(rowDataEndMDS)).EntireRow.Delete
For i = rowDataStartMDS To rowDataEndMDS
With wsMOST.Rows(i - 2)
' LUV(headerMOST, "Config Serial Number" & vbLf & "Manufacturer serial if no Configured serial", i - 2).Value = LUV(headerMDS, "Oracle Configuration SN", i).Value
.Cells(1).Value = LUV(headerMDS, "Oracle Configuration SN", i).Value
.Cells(2).Value = LUV(headerMDS, "Service Resource", i).Value
.Cells(3).Value = LUV(headerMDS, "Oracle Project Code", i).Value
.Cells(10).Value = LUV(headerMDS, "Location Street Address", i).Value & " " & LUV(headerMDS, "Location City", i).Value & " " & LUV(headerMDS, "Location State", i).Value & " " & LUV(headerMDS, "Location Zip", i).Text
.Cells(12).Value = LUV(headerMDS, "Cost Center (if required)", i).Value
.Cells(13).Value = LUV(headerMDS, "Department Name (if required)", i).Value
.Cells(14).Value = LUV(headerMDS, "Contract Effective Date", i).Value
.Cells(15).Value = LUV(headerMDS, "Account Entitlements (Service or Supplies or Both or Monitor Only)", i).Value
.Cells(18).Value = LUV(headerMDS, "Contract Effective Date", i).Value
.Cells(19).Value = LUV(headerMDS, "B&W Total Meter", i).Value
.Cells(25).Value = LUV(headerMDS, "BW Supplies Overage Rate", i).Value
.Cells(26).Value = LUV(headerMDS, "Color Total Meter", i).Value
.Cells(29).Value = LUV(headerMDS, "Color Supplies Overage Rate", i).Value
.Cells(30).Value = LUV(headerMDS, "Contract Effective Date", i).Value
.Cells(39).Value = LUV(headerMDS, "First Name", i).Value & " " & LUV(headerMDS, "Last Name", i).Value
.Cells(40).Value = LUV(headerMDS, "Phone", i).Value
.Cells(41).Value = LUV(headerMDS, "E-mail", i).Value
.Cells(43).Value = LUV(headerMDS, "Location Street Address", i).Value & " " & LUV(headerMDS, "Location City", i).Value & " " & LUV(headerMDS, "Location State", i).Value & " " & LUV(headerMDS, "Location Zip", i).Text
.Cells(44).Value = LUV(headerMDS, "Mfg", i).Value
.Cells(45).Value = LUV(headerMDS, "Oracle VPN (Item Number)", i).Value
.Cells(46).Value = LUV(headerMDS, "Ricoh Equipment ID", i).Value
.Cells(47).Value = LUV(headerMDS, "Serial Number", i).Value
End With
Next i
Application.ScreenUpdating = True
MsgBox "The data has been copied to the MOST Equipment Add worksheet. Please verify that the data has copied over properly!" ' 5/9/17 Fixed spelling
End Sub