Related
I have a program that opens an Excel spreadsheet and makes changes to it. I am always editing the first sheet but if it is a certain type of report I want to edit the second sheet as well. This all works fine for me on the first sheet and all but centering the text in the cell on the second sheet. I get an Object Required error only when I try to do this. I center the text in the cells on the first sheet no problem. The error only comes after I pass the object to the new procedure. Here is some of my code:
First Procedure
Private Sub OSummary1(strfile As String, strTableResults As String, dtUnivDt As Date)
Dim xlApp As Object
Dim objWorkbook As Object
Dim objSheet As Object
Set xlApp = CreateObject("Excel.Application")
Set objWorkbook = xlApp.Workbooks.Open(strfile)
Set objSheet = objWorkbook.Sheets(1)
Later in the code
ElseIf Mid(strTableResults, 11, 1) = 1 Then
Max = 11
Do Until i > Max
If .Cells(i, 4).Value = "0" And .Cells(i, 2).Value = "0" And .Cells(i, 3).Value = "0" Then
.Cells(i, 4).Value = "NA"
.Cells(i, 4).Interior.ColorIndex = 15
.Cells(i, 3).Value = "-"
.Cells(i, 2).Value = "-"
ElseIf .Cells(i, 2).Value = "0" Then
.Cells(i, 4).Value = "0.0"
.Cells(i, 4).Interior.ColorIndex = 22
ElseIf .Cells(i, 4).Value >= "95.00" Or .Cells(i, 4).Value = "100" Then
.Cells(i, 4).Interior.ColorIndex = 43
ElseIf .Cells(i, 4).Value >= "90.00" And .Cells(i, 4).Value < "95.00" Then
.Cells(i, 4).Interior.ColorIndex = 36
Else
.Cells(i, 4).Interior.ColorIndex = 22
End If
If .Cells(i, 4).Value = 0 Then
.Cells(i, 4).NumberFormat = "0.00%"
ElseIf Not .Cells(i, 4).Value Like "*.*" Then
.Cells(i, 4).NumberFormat = "#.00""%"""
ElseIf .Cells(i, 4).Value Like "*.#" Then
.Cells(i, 4).NumberFormat = "#.#0""%"""
Else
.Cells(i, 4).NumberFormat = "#.##""%"""
End If
If .Cells(i, 1).Value = "AppealNotificationTimeliness" Then
.Cells(i, 1).Font.Bold = True
.Cells(i, 2).Font.Bold = True
.Cells(i, 3).Font.Bold = True
.Cells(i, 4).Font.Bold = True
.Cells(i, 2).HorizontalAlignment = xlCenter
.Cells(i, 3).HorizontalAlignment = xlCenter
.Cells(i, 4).HorizontalAlignment = xlCenter
iB = Len(.Cells(i, 2).Value)
iC = Len(.Cells(i, 3).Value)
iD = .Cells(i, 4).Value
Else
'Indent header
.Cells(i, 1).IndentLevel = 3
'Indent sub-headers
If iB < 3 Then
.Cells(i, 2).IndentLevel = 5
ElseIf iB > 2 And iB < 5 Then
.Cells(i, 2).IndentLevel = 4
ElseIf iB > 4 And iB < 7 Then
.Cells(i, 2).IndentLevel = 3
Else
.Cells(i, 2).IndentLevel = 2
End If
If iC < 3 Then
.Cells(i, 3).IndentLevel = 4
ElseIf iC > 2 And iC < 5 Then
.Cells(i, 3).IndentLevel = 3
ElseIf iC > 4 And iC < 7 Then
.Cells(i, 3).IndentLevel = 2
Else
.Cells(i, 3).IndentLevel = 1
End If
If iD = "NA" Then
.Cells(i, 4).IndentLevel = 5
ElseIf iD = "100" Then
.Cells(i, 4).IndentLevel = 3
Else
.Cells(i, 4).IndentLevel = 4
End If
End If
i = i + 1
Loop
If Right(strTableResults, 3) = "FDR" Then
Call FDRTable1(objWorkbook)
End If
This all works fine for sheet 1
Second Procedure from Call above
Private Sub FDRTable1(ByRef objWorkbook As Object)
Dim objSheet As Object
Dim RowCnt As Integer
Dim CurrentRow As Integer
Dim CurrentRowVal As String
Dim iRange As Range
Dim iCells As Range
Dim i As Integer
Dim Max As Integer
Set objSheet = objWorkbook.Sheets(2)
i = 2
With objSheet
'Header
.Cells(1, 1).Font.Size = 12
.Range("A1:G1").Font.Bold = True
.Cells.EntireColumn.AutoFit
.Range("A2:G6").BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Range("A7:G9").BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Range("A10:G14").BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Range("A15:G17").BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
Max = 17
Do Until i > Max
If .Cells(i, 7).Value = "0" And .Cells(i, 4).Value = "0" And .Cells(i, 6).Value = "0" Then
.Cells(i, 7).Value = "NA"
.Cells(i, 7).Interior.ColorIndex = 15
.Cells(i, 4).Value = "-"
.Cells(i, 5).Value = "-"
.Cells(i, 6).Value = "-"
ElseIf .Cells(i, 4).Value = "0" Then
.Cells(i, 7).Value = "0.0"
.Cells(i, 7).Interior.ColorIndex = 22
ElseIf .Cells(i, 7).Value >= "95.00" Or .Cells(i, 7).Value = "100" Then
.Cells(i, 7).Interior.ColorIndex = 43
ElseIf .Cells(i, 7).Value >= "90.00" And .Cells(i, 7).Value < "95.00" Then
.Cells(i, 7).Interior.ColorIndex = 36
Else
.Cells(i, 7).Interior.ColorIndex = 22
End If
If .Cells(i, 7).Value = 0 Then
.Cells(i, 7).NumberFormat = "0.00%"
.Cells(i, 4).HorizontalAlignment.xlCenter
.Cells(i, 5).HorizontalAlignment.xlCenter
.Cells(i, 6).HorizontalAlignment.xlCenter
.Cells(i, 7).HorizontalAlignment.xlCenter
ElseIf Not .Cells(i, 7).Value Like "*.*" Then
.Cells(i, 7).NumberFormat = "#.00""%"""
.Cells(i, 4).HorizontalAlignment.xlCenter
.Cells(i, 5).HorizontalAlignment.xlCenter
.Cells(i, 6).HorizontalAlignment.xlCenter
.Cells(i, 7).HorizontalAlignment.xlCenter
ElseIf .Cells(i, 7).Value Like "*.#" Then
.Cells(i, 7).NumberFormat = "#.#0""%"""
.Cells(i, 4).HorizontalAlignment.xlCenter
.Cells(i, 5).HorizontalAlignment.xlCenter
.Cells(i, 6).HorizontalAlignment.xlCenter
.Cells(i, 7).HorizontalAlignment.xlCenter
Else
.Cells(i, 7).NumberFormat = "#.##""%"""
.Cells(i, 4).HorizontalAlignment.xlCenter
.Cells(i, 5).HorizontalAlignment.xlCenter
.Cells(i, 6).HorizontalAlignment.xlCenter
.Cells(i, 7).HorizontalAlignment.xlCenter
End If
i = i + 1
Loop
End With
End Sub
This all works too except I get the error when I try to center the text (.HorizontalAlignment.xlCenter). If I remove those lines, it works fine.
I have a piece of code that searches through Sheet("Sub Tasks") and if the number in column A is a decimal, it then makes cells in Sheet("PBS") Column D = to the offset of the decimal cell found in column A. However, I would like the code to work by making row 2,3,4,5,6, and so on (+1) in sheet PBS display the info from Sub tasks.
But at the moment, the info is displayed in the same layout as it is in Sheet("Sub Tasks"). What am i missing from the code.
Dim Lastrow3 As Long, r As Long, n As Long, cell As Range, ws As Worksheet, Lastrow1 As Long
Lastrow3 = Sheets("Sub Tasks").Range("B" & Rows.Count).End(xlUp).Row
Lastrow1 = Sheets("PBS ").Range("D" & Rows.Count).End(xlUp).Row
n = 2
With Worksheets("Sub Tasks")
For Each cell In Sheets("Sub Tasks").Range("A2:A" & Lastrow3)
If IsNumeric(cell.value) Then
If cell.value = Int(cell.value) Then
Worksheets("PBS ").Cells(n, "C").value = cell.value
Worksheets("PBS ").Cells(n, "D").value = cell.Offset(0, 1).value
Worksheets("PBS ").Cells(n, "B").value = cell.Offset(0, 8).value
Worksheets("PBS ").Cells(n, "A").value = cell.Offset(0, 7).value
Worksheets("PBS ").Cells(n, "H").value = cell.Offset(0, 23).value
Worksheets("PBS ").Cells(n, "E").value = cell.Offset(0, 3).value
Else
End If
Else
End If
n = n + 1
Next cell
End With
``````````````````````````
move n = n + 1 to another place.
n = 2
With Worksheets("Sheet1")
For Each cell In Sheets("Sheet1").Range("A2:A" & Lastrow3)
If IsNumeric(cell.Value) Then
If cell.Value = Int(cell.Value) Then
Worksheets("Sheet3").Cells(n, "C").Value = cell.Value
Worksheets("Sheet3").Cells(n, "D").Value = cell.Offset(0, 1).Value
Worksheets("Sheet3").Cells(n, "B").Value = cell.Offset(0, 8).Value
Worksheets("Sheet3").Cells(n, "A").Value = cell.Offset(0, 7).Value
Worksheets("Sheet3").Cells(n, "H").Value = cell.Offset(0, 23).Value
Worksheets("Sheet3").Cells(n, "E").Value = cell.Offset(0, 3).Value
n = n + 1
Else
End If
Else
End If
Next cell
End With
please i need help on this code: it compares different values in different column at the same row level and executes the "then statement". But the code i wrote doesn't real function as i expected.
Sub Z_status()
Dim wsO As Worksheet
Set wsO = Sheets("Sending List")
Dim i As Long
Dim Lastrow As Long
With wsO
Lastrow = Cells(Rows.Count, 5).End(xlUp).Row
'Lastrow_2 = Cells(Rows.Count, 6).End(xlUp).Row
'Lastrow_3 = Cells(Rows.Count, 3).End(xlUp).Row
'Lastrow_4 = Cells(Rows.Count, 8).End(xlUp).Row
For i = Lastrow To 2 Step -1
'For j = Lastrow_2 To 2 Step -1
'For k = Lastrow_3 To 2 Step -1
'For l = Lastrow_3 To 2 Step -1
Cells(1, 7).Value = "Expected state"
If (Cells(i, 5).Value = "MTS" Or Cells(i, 5).Value = "MTO") And (Cells(i, 6).Value = "1/1/1900" Or Cells(i, 6).Value > Date) And (Cells(i, 3).Value = 0) And (Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z1"
ElseIf (Cells(i, 5).Value = "MTS" Or Cells(i, 5).Value = "MTO") And (Cells(i, 6).Value = "1/1/1900" Or Cells(i, 6).Value > Date) And (Cells(i, 3).Value = 0) And (Cells(i, 8).Value > 0 Or Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z3"
ElseIf (Cells(i, 5).Value = "MTS" Or Cells(i, 5).Value = "MTO") And (Cells(i, 6).Value = "1/1/1900" Or Cells(i, 6).Value > Date) And (Cells(i, 3).Value > 0) And (Cells(i, 8).Value > 0 Or Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z5"
ElseIf (Cells(i, 5).Value = "Obsolete") And (Cells(i, 6).Value < Date) And (Cells(i, 3).Value > 0) And (Cells(i, 8).Value > 0 Or Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z7"
ElseIf (Cells(i, 5).Value = "Obsolete") And (Cells(i, 6).Value < Date) And (Cells(i, 3).Value = 0) And (Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z9"
End If
Next i
' Next j
' Next k
' Next l
End With
End Sub
1 Your conditions for Z3 and z5 are identical
2 You can write
(Cells(i, 8).Value > 0 Or Cells(i, 8).Value = 0)
as (Cells(i, 8).Value >= 0 )
Your ifs can be written more clearly as
If (Cells(i, 5).Value = "MTS" Or Cells(i, 5).Value = "MTO") And (Cells(i, 6).Value = "1/1/1900" Or Cells(i, 6).Value > Date) Then
If (Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z1"
Else
If (Cells(i, 8).Value > 0) Then
Cells(i, 7).Value = "Z5"
End If
End If
Else
If (Cells(i, 5).Value = "Obsolete") Then
If (Cells(i, 6).Value < Date) And (Cells(i, 8).Value >= 0) Then
If (Cells(i, 3).Value > 0) Then
Cells(i, 7).Value = "Z7"
Else
If (Cells(i, 3).Value = 0) Then
Cells(i, 7).Value = "Z9"
Else
'This case is undefined
End If
End If
Else
'This case is undefined
End If
Else
'this case is undefined
End If
End If
Hopefully you can work out the errors more easily in this form
I have the following code
Dim i As Integer
For i = 3 To 10
If Range("H3").Value = Cells(i, 2).Value And Range("I3").Value < Cells(i, 4).Value And _
Range("I3").Value >= Cells(i, 3).Value Then
Range("J3").Value = Cells(i, 5).Value
End If
Next i
I want the value of J3 to represent the sum of all the iterations and not just the last iteration if i. Can it be done?
While there are certainly better methods of adding up cells, for your particular method this should work.
Dim i As long, lTotal as long
For i = 3 To 10
If Range("H3").Value = Cells(i, 2).Value And Range("I3").Value < Cells(i, 4).Value And _
Range("I3").Value >= Cells(i, 3).Value Then
lTotal = Cells(i, 5).Value + lTotal
End If
Next i
Range("J3").Value = lTotal
Keep a running total of of your loop, then use the running total as your cell's value after you've finished the loop
Change this line
Range("J3").Value = Cells(i, 5).Value
To:
Range("J3").Value = Range("J3").Value + Cells(i, 5).Value
I have a code which Sheet "RAW" is updated each day with more rows and updates the existing rows, I'm trying to get the number in Column B to match Column A in sheet data, then depending on what information is in other columns add 1 to a value in a column (17 different options)
It's basically going to be used as a tracker to check how many days something is on a specific status and I need to keep it for historical Measuring indefintely. here is what I have so far which doesn't seem to work.
Additionally I would also like it to measure an 18th catagory if it is missing from the data list if this is possibble?
'status tracking
Sub Status_Track()
Dim a As Long 'topic number
Dim Z As Long
Dim R As Long
Dim i As Long
Dim S As Long
Dim D As Long
Worksheets("RAW").Activate
R = Cells(Rows.Count, 2).End(xlUp).Row
C = Cells(1, Columns.Count).End(xlToLeft).Column
Z = 0
i = 2
Do Until i > R
'ident
If Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "ERKA") Then
Z = Worksheets("Data").Cells(i, 6) + 1
Worksheets("Data").Cells(i, 6).Value = Z
ElseIf Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "INBA") Then
'Inba
Z = Worksheets("Data").Cells(i, 7) + 1
Worksheets("Data").Cells(i, 7).Value = Z
ElseIf Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "ABGE") Then
'Abge
Z = Worksheets("Data").Cells(i, 8) + 1
Worksheets("Data").Cells(i, 8).Value = Z
ElseIf Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "GELO") Then
'Gelo
Z = Worksheets("Data").Cells(i, 5) + 1
Worksheets("Data").Cells(i, 5).Value = Z
ElseIf Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "UEBE") And (Cells(i, 11) = 0) Then
'UEBE
Z = Worksheets("Data").Cells(i, 9) + 1
Worksheets("Data").Cells(i, 9).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "<1") Then
'1
Z = Worksheets("Data").Cells(i, 10) + 1
Worksheets("Data").Cells(i, 10).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "6") Then
'6
Z = Worksheets("Data").Cells(i, 11) + 1
Worksheets("Data").Cells(i, 11).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "9") Then
'9
Z = Worksheets("Data").Cells(i, 12) + 1
Worksheets("Data").Cells(i, 12).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "10") Then
'10
Z = Worksheets("Data").Cells(i, 13) + 1
Worksheets("Data").Cells(i, 13).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "15") Then
'15
Z = Worksheets("Data").Cells(i, 14) + 1
Worksheets("Data").Cells(i, 14).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "30") Then
'30
Z = Worksheets("Data").Cells(i, 15) + 1
Worksheets("Data").Cells(i, 15).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "50") Then
'50
Z = Worksheets("Data").Cells(i, 16) + 1
Worksheets("Data").Cells(i, 16).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "60") Then
'60
Z = Worksheets("Data").Cells(i, 17) + 1
Worksheets("Data").Cells(i, 17).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "70") Then
'70
Z = Worksheets("Data").Cells(i, 18) + 1
Worksheets("Data").Cells(i, 18).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "80") Then
'80
Z = Worksheets("Data").Cells(i, 19) + 1
Worksheets("Data").Cells(i, 19).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "90") Then
'90
Z = Worksheets("Data").Cells(i, 20) + 1
Worksheets("Data").Cells(i, 20).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "97") Then
'97
Z = Worksheets("Data").Cells(i, 21) + 1
Worksheets("Data").Cells(i, 21).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "100") Then
'100
Z = Worksheets("Data").Cells(i, 22) + 1
Worksheets("Data").Cells(i, 22).Value = Z
End If
Loop
End Sub
It could look something like that to find the corresponding identifier
Option Explicit 'must be the first line in a module: forces you to declare any variables before use
'status tracking
Sub Status_Track_Extended()
Dim wsRaw As Worksheet, wsData As Worksheet
Set wsRaw = ThisWorkbook.Worksheets("RAW")
Set wsData = ThisWorkbook.Worksheets("Data")
Dim LastRow As Long
LastRow = wsRaw.Cells(wsRaw.Rows.Count, 2).End(xlUp).Row 'find last row in sheet RAW
Dim FoundCell As Range, FoundRow As Long
Dim DataCol As Long
Dim i As Long
For i = 2 To LastRow 'start at row 2 up to last used row
'find corresponding row by identifier (column 2) in sheet Data
Set FoundCell = wsData.Columns(1).Find(wsRaw.Cells(i, 2))
If Not FoundCell Is Nothing Then 'only do the follwing if the identifier was found in sheet Data
FoundRow = FoundCell.Row
'ident
If wsRaw.Cells(i, 13) = "ERKA" Then
wsData.Cells(FoundRow, 6).Value = wsData.Cells(FoundRow, 6).Value + 1
ElseIf wsRaw.Cells(i, 13) = "INBA" Then
'Inba
wsData.Cells(FoundRow, 7).Value = wsData.Cells(FoundRow, 7).Value + 1
ElseIf wsRaw.Cells(i, 13) = "ABGE" Then
'Abge
wsData.Cells(FoundRow, 8).Value = wsData.Cells(FoundRow, 8).Value + 1
ElseIf wsRaw.Cells(i, 13) = "GELO" Then
'Gelo
wsData.Cells(FoundRow, 5).Value = wsData.Cells(FoundRow, 5).Value + 1
ElseIf wsRaw.Cells(i, 13) = "UEBE" And wsRaw.Cells(i, 11) = 0 Then
'UEBE
wsData.Cells(FoundRow, 9).Value = wsData.Cells(FoundRow, 9).Value + 1
ElseIf wsRaw.Cells(i, 11) = 1 Then
Select Case wsRaw.Cells(i, 28)
Case "<1"
wsData.Cells(FoundRow, 10).Value = wsData.Cells(FoundRow, 10).Value + 1
Case "6"
wsData.Cells(FoundRow, 11).Value = wsData.Cells(FoundRow, 11).Value + 1
Case "9"
wsData.Cells(FoundRow, 12).Value = wsData.Cells(FoundRow, 12).Value + 1
Case "10"
wsData.Cells(FoundRow, 13).Value = wsData.Cells(FoundRow, 13).Value + 1
Case "15"
wsData.Cells(FoundRow, 14).Value = wsData.Cells(FoundRow, 14).Value + 1
Case "30"
wsData.Cells(FoundRow, 15).Value = wsData.Cells(FoundRow, 15).Value + 1
Case "50"
wsData.Cells(FoundRow, 16).Value = wsData.Cells(FoundRow, 16).Value + 1
Case "60"
wsData.Cells(FoundRow, 17).Value = wsData.Cells(FoundRow, 17).Value + 1
Case "70"
wsData.Cells(FoundRow, 18).Value = wsData.Cells(FoundRow, 18).Value + 1
Case "80"
wsData.Cells(FoundRow, 19).Value = wsData.Cells(FoundRow, 19).Value + 1
Case "90"
wsData.Cells(FoundRow, 20).Value = wsData.Cells(FoundRow, 20).Value + 1
Case "97"
wsData.Cells(FoundRow, 21).Value = wsData.Cells(FoundRow, 21).Value + 1
Case "100"
wsData.Cells(FoundRow, 22).Value = wsData.Cells(FoundRow, 22).Value + 1
End Select
End If
Else 'error if identifier was not found
MsgBox "Identifier '" & wsRaw.Cells(i, 2) & "' could not be found in sheet 'Data'.", vbExclamation + vbOKOnly
End If
Next i
End Sub