# code to compare two worksheets and find the difference in fo

#### trimmer69

##### Active Member
i have 2 worksheets that appear to be the same,but the code i am using will only work on one workbook. I have tried formatting as general then as fractions, i have tried removing all formats but the code will work on one ws and not the other. Is there some code that will look at each sheet and be able to compare formatting

### Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

#### XLGibbs

##### Well-known Member
The problem is not the formatting.

Are you using code or formulas?

In the code, it is probably specifically referencing the first worksheet. You would have to change the code to look at the second...

If you have code, post it for more help.

#### trimmer69

##### Active Member
This code was generated in xls97 but since my company has upgraded to 2003. it works great for pma strappings and half the time for ews strappings. i get run-time error 13
Rich (BB code):
``````Attribute VB_Name = "Module1"

Function F_t(x As String)
On Error GoTo per1
berta = Trim(x)
ftti = Len(berta)
ftt = InStr(1, CStr(berta), "'", vbTextCompare)
ftt1 = InStr(1, CStr(berta), "-", vbTextCompare)
ftt2 = InStr(1, CStr(berta), " ", vbTextCompare)
If ftt <> 0 And ftt < ftti Then
fttf = ftt: intr = "'"
ElseIf ftt1 <> 0 And ftt1 < ftt2 Or ftt2 = 0 Then
fttf = ftt1: intr = "-"
Else
fttf = ftt2: intr = " "
End If
ftt3 = Trim(Left(berta, fttf - 1))
F_t = ftt3
per1:
End Function
Function I_n(x As String)
On Error GoTo per1
ftt2 = F_t(x)
lrg = Len(ftt2)
berta = Trim(Mid(x, lrg + 2, Len(x)))
If Left(berta, 1) = "-" Then berta = Trim(Mid(x, lrg + 3, Len(x)))
fttf = 2
ftt = InStr(1, CStr(berta), Chr(34), vbTextCompare): ftt1 = InStr(1, CStr(berta), "-", vbTextCompare)
ftt2 = InStr(1, CStr(berta), " ", vbTextCompare)
If ftt = fttf Or ftt1 = fttf Then fttf = 1
If ftt <> 0 Then
intr1 = Chr(34)
ElseIf ftt1 <> 0 Then
intr1 = "-"
Else
intr1 = " "
End If
fttd = InStr(1, berta, "/", vbTextCompare)
If fttd <> 0 And ftt1 = 0 And ftt2 = 0 And ftt = Len(berta) Or fttd <> 0 And ftt = Len(berta) And ftt1 = 0 And ftt2 = 0 Then
MsgBox "Give a Space between Inches and Fraction in Present measurement", vbExclamation, "Inches Fraction"
End
End If
ftt4 = Trim(Left(berta, fttf))
I_n = CDbl(ftt4)
per1:
End Function
Function F_r(x As String)
On Error GoTo per1
berta = Trim(x)
ftt2 = F_t(x)
lrg = Len(ftt2) + 1
ftt21 = I_n(x)
lrg1 = Len(ftt21)
To_tal = lrg + lrg1
ftt = InStr(1, berta, "/", vbTextCompare)
If ftt = 0 Then
If To_tal <> Len(berta) Then
F_r = Right(berta, 1)
Else
F_r = 0
End If
Exit Function
End If
ftt345 = Trim(Right(berta, Len(berta) - ftt + 3))
If Left(ftt345, 1) = Chr(34) Or Left(ftt345, 1) = "-" Then ftt345 = Trim(Right(berta, Len(berta) - ftt + 2))
If Right(ftt345, 1) = Chr(34) Then ftt345 = Trim(Left(ftt345, Len(ftt345) - 1))
F_r = ftt345
per1:
End Function
Function Fr_Un(x)
If x = "0" Or x = "0/0" Or x = "" Then
Fr_Un = 0
Exit Function
End If
ftt5 = x
nu1 = InStr(1, ftt5, "/", vbTextCompare)
If nu1 = 0 Then
Fr_Un = x * 0.125
Exit Function
End If
ftt5a = Left(ftt5, nu1 - 1)
ftt5b = Right(ftt5, Len(ftt5) - nu1)
Fr_Un = ftt5a / ftt5b
End Function
Function Ft_Uni(x As String)
Ft_Uni = (F_t(x) * 12) + I_n(x) + Fr_Un(F_r(x))
End Function

Sub PmaRunsheets()
With ActiveWorkbook
.Protect "", True, True
.Unprotect
End With
'    PM_A = STARTING IN COLUMN A,TOTAL COLUMNS USED FOR STRAPPING
'    PM_A1 = ROW IN WHICH THE STRAPPINGS START.  IE: O FT. , 1 FT.,
'    PM_A2 = ZERO GAUGE OF STRAPPINGS. IS THE FIRST INCREMENT OF STRAPPING CHART
'    PM_A3 = ZERO GAUGE OF STRAPPINGS TO THE START OF THE SECOND PAGE OF STRAPPING START IE: 10 FT. 11 FT.
'    PM_A4 = 14 TEXT REF.HEIGHT
'    PM_A5 = CELL WITH REFERENCE HEIGHT IN IT
'    PMA_6 = COVERS 1 FOOT RANGE IN 1/4 INCREMENT'S 0.0 TO 11.75 INCHES
PM_A = 21: PM_A1 = 6: PM_A2 = 7: PM_A3 = 66: PM_A4 = 14: PM_A5 = "T5": PMA_6 = 48: PMA_7 = 7
msj = InputBox("Select Company:" & Chr(13) & "PMA = 1" & Chr(13) & "Inspectorate = 2" & Chr(13) & "Saybolt = 3" _
& Chr(13) & "ITS = 4", "Select Calibration Company", 1)

Select Case msj
Case Is = 2
PM_A = 31: PM_A1 = 8: PM_A2 = 9: PM_A3 = 79: PM_A4 = 14: PM_A5 = "L60": PMA_6 = 49 'INSPECTORATE
Case Is = 3
' PM_4 GAUGE HEIGHT = 13
' PM_4 MMC GAUGE HEIGHT =17
' PM_4 HERMETIC GAUGE HEIGHT = 22
Rows("1:3").Delete: Rows("57:58").Delete

PM_A = 21: PM_A4 = 13: PM_A5 = "B5": PMA_7 = 7: PMA_6 = 48 'SAYBOLT

Case Is = 4
PM_A3 = 62: PM_A5 = "U5" 'ITS
End Select
F_F = InputBox("How many pages do you Have to transform?" & Chr(13) & "By default is 2", "pages...", 2)
On Error Resume Next 'GoTo 95
Worksheets.Add.Move After:=Worksheets(Worksheets.Count): huy = Sheets.Count: huy = Sheets(huy).Name
95  If Err.Number = 1004 Then
GoTo 96
'    Else
'        GoTo 49
End If
MO = PM_A2: MO1 = PM_A1 'CHANGE
lo = 3
M_e = 0
MI = 2
TEL = Sheets("Sheet1").Range(PM_A5): If PM_A5 = "L58" Then TEL = Application.WorksheetFunction.Replace(TEL, Application.WorksheetFunction.Search("REFERENCE ", TEL), 1, "")
Hei_RefI = Mid(Application.WorksheetFunction.Replace(TEL, Application.WorksheetFunction.Search("'", TEL), 1, ""), PM_A4, 10)
Hei_RefI = Application.WorksheetFunction.Replace(Hei_RefI, Application.WorksheetFunction.Search(Chr(34), Hei_RefI), 1, "")
Hei_Ref = Ft_Uni(CStr(Hei_RefI))
Sheets(huy).Range("a1") = " ": Sheets(huy).Range("b1") = Hei_Ref
Do Until q > F_F
N = PM_A3 * q 'CHANGE
Do Until lo > PM_A 'CHANGE
On Error GoTo 49
c_u = CDbl(Trim(Left(Sheets("Sheet1").Cells(MO1 + N, lo), 3))) * 12
Do Until MO - PMA_7 = PMA_6 'CHANGE
If lo > PM_A Then Exit Do
If InStr(1, Sheets("Sheet1").Cells(MO + N, lo - 1), "/", vbTextCompare) = 0 Then
M_e1 = Sheets("Sheet1").Cells(MO + N, lo - 1)
M_e = c_u + M_e1
Else
M_e = c_u + M_e1 + Fr_Un(Sheets("Sheet1").Cells(MO + N, lo - 1))
End If
If Sheets(huy).Cells(MI - 1, 1) = M_e Or _
InStr(1, Sheets("Sheet1").Cells(MO + N, lo), "F", 3) <> 0 Then GoTo 140
If Trim(Sheets("Sheet1").Cells(MO + N, lo)) <> "" Then
Sheets(huy).Cells(MI, 1) = M_e
Sheets(huy).Cells(MI, 2) = Sheets("Sheet1").Cells(MO + N, lo)
'Sheets(HUY).Cells(mi, 5) = Hei_ref - M_e
'Sheets(HUY).Cells(mi, 6) = Cells(mo + n, lo)
MI = MI + 1
End If
140                MO = MO + 1
Loop
MO = PMA_7: lo = lo + 2
Loop
lo = 3
q = q + 1
Loop

'run-time error 13 type mismatch on line of code below

49  DES1 = Application.WorksheetFunction.RoundDown(Sheets(huy).Cells(MI - 1, 1) - 3, 0)
MO1 = 2: mo1a = 2: mo1b = 3
Sheets(huy).Cells(2, 5) = Sheets(huy).Cells(2, 1): CA_TE = Application.Ceiling(Sheets(huy).Cells(2, 1), 3)
If CA_TE = 0 Or CA_TE = Sheets(huy).Cells(2, 1) Then CA_TE = CA_TE + 3
If Sheets(huy).Cells(2, 1) = 0 Then GoTo 165
Sheets(huy).Cells(3, 5) = CA_TE
Sheets(huy).Cells(2, 6) = Sheets(huy).Cells(2, 2)
des = Sheets(huy).Cells(3, 5)
Do Until Sheets(huy).Cells(MO1, 1) = DES1
If Sheets(huy).Cells(MO1, 1) = des Then
Sheets(huy).Cells(mo1b, 6) = Sheets(huy).Cells(MO1, 2)
mo1b = mo1b + 1
des = des + 3
Sheets(huy).Cells(mo1b, 5) = des
End If
MO1 = MO1 + 1
Loop
Sheets(huy).Cells(mo1b, 6) = Sheets(huy).Cells(MO1, 2)
Do Until Sheets(huy).Cells(MO1, 1) = ""
Sheets(huy).Cells(mo1b, 5) = Sheets(huy).Cells(MO1, 1)
Sheets(huy).Cells(mo1b, 6) = Sheets(huy).Cells(MO1, 2)
mo1b = mo1b + 1
MO1 = MO1 + 1
Loop
GoTo 173
165 mo1b = 2
Do Until Sheets(huy).Cells(MO1, 1) > 3
Sheets(huy).Cells(mo1b, 5) = Sheets(huy).Cells(MO1, 1)
Sheets(huy).Cells(mo1b, 6) = Sheets(huy).Cells(MO1, 2)
mo1b = mo1b + 1
MO1 = MO1 + 1
Loop
MO1 = MO1 + 11
Do Until Sheets(huy).Cells(MO1, 1) = ""
Sheets(huy).Cells(mo1b, 5) = Sheets(huy).Cells(MO1, 1)
Sheets(huy).Cells(mo1b, 6) = Sheets(huy).Cells(MO1, 2)
mo1b = mo1b + 1
MO1 = MO1 + 12
Loop
Sheets(huy).Cells(mo1b, 5) = Sheets(huy).Cells(MI - 1, 1)
Sheets(huy).Cells(mo1b, 6) = Sheets(huy).Cells(MI - 1, 2)
173 cas = Sheets(huy).Range("e2:f" & MI)
Sheets(huy).Range("a2:b" & MI) = cas
Sheets(huy).Range("e2:f" & MI) = ""
Sheets(huy).Activate
Dim x As Long
Dim LastRow As Long
LastRow = Range("B100").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("B:B"), Range("B" & x).Value) > 1 Then
Range("B" & x).EntireRow.Delete
End If
Next
F_F = ActiveWorkbook.Name: F_F1 = Format(Trim(Left(F_F, 5)), ">")
F_F23 = Mid(F_F, 7, Len(F_F)): FILENAME1 = Application.WorksheetFunction.Replace(F_F23, Application.WorksheetFunction.Search(".Xls", F_F23), 4, "")
If InStr(1, FILENAME1, " ") > 0 Then _
FILENAME1 = Application.WorksheetFunction.Replace(FILENAME1, Application.WorksheetFunction.Search(" ", FILENAME1), 1, "")
If InStr(1, FILENAME1, " ") > 0 Then _
FILENAME1 = Application.WorksheetFunction.Replace(FILENAME1, Application.WorksheetFunction.Search(" ", FILENAME1), 1, "")
If InStr(1, FILENAME1, "B") > 0 Then
FILENAME1 = Application.WorksheetFunction.Replace(FILENAME1, Application.WorksheetFunction.Search("B", FILENAME1), 1, "")
If InStr(1, FILENAME1, " ") > 0 Then _
FILENAME1 = Application.WorksheetFunction.Replace(FILENAME1, Application.WorksheetFunction.Search(" ", FILENAME1), 1, "")
If InStr(1, FILENAME1, " ") > 0 Then _
FILENAME1 = Application.WorksheetFunction.Replace(FILENAME1, Application.WorksheetFunction.Search(" ", FILENAME1), 1, "")
End If
If InStr(1, FILENAME1, "T") > 0 Then
FILENAME1 = Application.WorksheetFunction.Replace(FILENAME1, Application.WorksheetFunction.Search("T", FILENAME1), 1, "")
If InStr(1, FILENAME1, " ") > 0 Then _
FILENAME1 = Application.WorksheetFunction.Replace(FILENAME1, Application.WorksheetFunction.Search(" ", FILENAME1), 1, "")
If InStr(1, FILENAME1, " ") > 0 Then _
FILENAME1 = Application.WorksheetFunction.Replace(FILENAME1, Application.WorksheetFunction.Search(" ", FILENAME1), 1, "")
End If
F_F22 = Application.WorksheetFunction.Replace(F_F, Application.WorksheetFunction.Search(".Xls", F_F), 4, "")
If F_F1 <> "KIRBY" Then FILENAME1 = InputBox("This is File Name", "No Kirby", F_F22)
ActiveWorkbook.SaveAs Filename:="H:\CSV FILES\new csv\" & FILENAME1 & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
End Sub
thanks for reviewing``````

#### XLGibbs

##### Well-known Member
Which line does the run time error occur on?

#### trimmer69

##### Active Member
49 DES1 = Application.WorksheetFunction.RoundDown(Sheets(huy).Cells(MI - 1, 1) - 3, 0)

#### XLGibbs

##### Well-known Member
Okay, I was going through this, without being able to run it of course, but the nearest I can come to an answer is the value in that line

DES1 = Application.WorksheetFunction.RoundDown(Sheets(huy).Cells(MI - 1, 1) - 3, 0)

is not a value, specifically, whatever is in cells(MI-1,1)

if it is a number, but in text format you can circumvent by
Code:
``DES1 = Application.WorksheetFunction.RoundDown (Val(Sheets(huy).Cells(MI - 1, 1) - 3, 0))``

Which will convert it to a value outside the remainder of the function, thus allowing it to ROUNDDOWN.

I didn;t notice your highlight in the code above until after you pointed out which line it was on...sorry took awhile to get back.

Replies
1
Views
195
Replies
8
Views
85
Replies
2
Views
60
Replies
1
Views
181
Replies
3
Views
69