If statement ignoreing some cells

  • Thread starter Thread starter Legacy 93538
  • Start date Start date
L

Legacy 93538

Guest
Hi

I have written a macro which loops through a cell range within a workbook opened by the macro and complete quite a few If statements to gather data and populate a new workbook created by the macro.

However i need the macro to ignore any cell value within column E of the corresponding row that starts with Total or Sub. I ahve programmed it in and works for soem of them but not all of them.

Rich (BB code): 
Option Explicit
Dim stFormatStyle, stResult As String
Dim iStart, iEnd, iDigitsAfterDecimalPoint, iDecimals As Integer
Dim bIsPercentage As Boolean
Sub PPiiiCalcs()
Dim ConvertVN, ManualVN, ManualImportVN As String
Dim strFldr As String
Dim PPCWB, PPFWB As Workbook
Dim PPCWBSht As Worksheet
Dim SConvertVN, SManualVN As Integer
Dim ColN, NRow As Long
Dim cell As Range

'Version number of Input Reference Form to be convert
ConvertVN = Application.InputBox("Please enter the version number of the Input Reference Form to be convert", "Convert Version Entry Box", SConvertVN)
    
'Is previously manually entered data to be imported
ManualVN = MsgBox("Would you like previously entered data to be imported", vbQuestion + vbYesNo, "Manual Version question box")
    If ManualVN = vbYes Then
        ' If yes to ManualVN then what version number to import from
        ManualImportVN = Application.InputBox("Please enter the version number of Input Reference Table the data is to be imported from", "Manual Version Entry Box", SManualVN)
    End If

'Set variables
strFldr = "R:\HondaCarsEurope\Markets\Germany\PPIII\Tables"
Set PPCWB = Application.Workbooks.Add
PPCWB.Sheets.Add.Name = "CalcAPD"
Set PPCWBSht = PPCWB.Sheets("CalcAPD")
Set PPFWB = Application.Workbooks.Open(strFldr & "/" & "HDE_PPIII_MONTH_Input_Reference_form_V" & ConvertVN & ".xlsx")

'Add column titles to new workbook
PPCWBSht.Activate
ColN = 1
PPCWBSht.Cells(ColN, 1).Resize(, 8).Value = Array("CalcID", "CalcDescription", "Calcname", "Calculations", _
"Department", "Category", "NumFormat", "ChartOrder")

'Loop through the form cells and populate the calculations table
NRow = 2
Application.StatusBar = "Loop through calcs Form and populate calculations table"
For Each cell In PPFWB.Sheets("IRFORM").Range("F4:T263")
    If cell.Value <> "" Then
        If cell.Interior.Color = RGB(217, 217, 217) Then
            If Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "Total" Then
                PPCWBSht.Cells(NRow, 4).Value = "True"
            
            ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "Sub" Then
                PPCWBSht.Cells(NRow, 4).Value = "True"
            
            Else:
            If PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & "1").Value = "KPI" Then
                PPCWBSht.Cells(NRow, 4).Value = cell.Offset(, -1) & "*" & cell.Offset(-1, -1)
    
            ElseIf PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & "1").Value = "12  Mths" Then
                If Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Sales Per Unit" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row + 2).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row + 1).Value
                ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Gross Per Unit" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row + 2).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row + 1).Value
        
                ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "Gap" & "*Gross PerUnit" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row + 1).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value
                ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "Paint" & "*Gross Per Unit" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row + 1).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value
                ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Gross %" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value & " / " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
                ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*% Sales" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value & " / " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
                Else: PPCWBSht.Cells(NRow, 4).Value = "Sum " & "F" & cell.Row & ":" & "R" & cell.Row
                End If
            End If
            
            If Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Gross %" Then
                PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value & " / " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
            ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*% Sales" Then
                PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value & " / " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
            
            ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Turnover" Then
                PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 3).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value
            
            ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Gross" Then
                If Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Motorcycles Gross" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 4).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
                ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "Gap " & "*Gross" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
                ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "Paint " & "*Gross" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 1).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
                Else: PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 4).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
                
                End If
            
            ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Sales" Then
                
                If Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "*Motorcycles Sales" Then
                    PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 3).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
                
                Else: PPCWBSht.Cells(NRow, 4).Value = PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 3).Value & " * " & PPFWB.Sheets("IRFORM").Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.Column, 1) & cell.Row - 2).Value
                
                End If
            
            End If
            End If
                
        PPCWBSht.Cells(NRow, 1).Value = Mid(cell.Value, 4, Len(cell.Value) - 4)
        PPCWBSht.Cells(NRow, 2).Value = PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Value
 
        PPCWBSht.Cells(NRow, 3).Value = cell.Value
        PPCWBSht.Cells(NRow, 5).Value = PPFWB.Sheets("IRFORM").Range("A" & cell.Row)
        PPCWBSht.Cells(NRow, 6).Value = PPFWB.Sheets("IRFORM").Range("B" & cell.Row)
        PPCWBSht.Cells(NRow, 7).Value = iDecimal(cell)
        NRow = NRow + 1
        Application.StatusBar = cell.Address
        End If
End If
Next cell
'PPFWB.Close
PPCWBSht.Range("A1:H1").AutoFilter
Range("A1:H1").Activate
PPCWBSht.Cells.EntireColumn.AutoFit
MsgBox "Macro Finished"
End Sub
'Function to determine the Number format
Function iDecimal(Target As Range) As String
    'Resets the iDigitsAfterDecimalPoint variable to 0
    iDigitsAfterDecimalPoint = 0
    
    'Gets the formatting style for the cell
    stFormatStyle = Target.NumberFormat
    
    'If the format style is "general", return the default string and exit the function
    If stFormatStyle = "General" Then
        iDecimal = "%10.0f%"
        Exit Function
    End If
    
    'If the format style is "comma", find the number of digits after decimal and return the string
    If InStr(stFormatStyle, "#,##") Then
        'find the period
        iStart = InStr(stFormatStyle, ".")
        'find the ending 0
        iEnd = InStr(iStart, stFormatStyle, "_")
        'subtract the two to get the number of digits after the period
        iDigitsAfterDecimalPoint = iEnd - iStart - 1
        'return the string
        iDecimal = "%10." & iDigitsAfterDecimalPoint & "f%"
        'exit the function
        Exit Function
    End If
    
    'If the last character of the NumberFormat string is  a percentage sign, then sets a Boolean to true
    If Right(stFormatStyle, 1) = "%" Then
         bIsPercentage = True
    Else
         bIsPercentage = False
    End If
    'find the decimal point position:
    iStart = InStr(stFormatStyle, ".")
    
    'If the decimal point is 0
    If iStart = 0 Then
        iDigitsAfterDecimalPoint = 0
    Else
        iDigitsAfterDecimalPoint = Len(stFormatStyle) - iStart
    End If
    
    'If it's a percentage format with digits after period, subtract one to account for the "%" sign
    If bIsPercentage And iStart > 0 Then
        If bIsPercentage Then iDigitsAfterDecimalPoint = iDigitsAfterDecimalPoint - 1
    End If
    
    'Creating the string to be placed into the cell
    stResult = "%10." & iDigitsAfterDecimalPoint & "f%"
    If bIsPercentage Then stResult = stResult & "%"
    
    'return the string
    iDecimal = stResult
End Function

Does anyone know why the code i highligthed red above is only working on some of the cell values that start with Total or Sub?

Thanks

Jessicaseymour
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
Try

Rich (BB code): 
If Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "Total*" Then
                PPCWBSht.Cells(NRow, 4).Value = "True"
            
            ElseIf Trim(PPFWB.Sheets("IRFORM").Range("E" & cell.Row).Text) Like "Sub*" Then
                PPCWBSht.Cells(NRow, 4).Value = "True"
 
Upvote 0
Cool That works!!

Didn't think you needed to use wildcard character when using like
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Would like to make edits to VBA Calendar Code
Replies
8
Views
925
Legacy 352679
L
A
  • Solved
Fixing the macro for text splitting (rows being skipped)
Replies
6
Views
462
Georgiboy
Georgiboy
M
  • Solved
Optimizing my rows to send e-mail to different address
Replies
2
Views
175
MasterBash
M
mehidy1437
  • Question Question
Requesting for experts comments suggestion on my vba code
Replies
5
Views
890
mehidy1437
mehidy1437
P
  • Question Question
putting a snippet of code from one to another somehow
Replies
5
Views
309
Patriot2879
P

Forum statistics

Threads
1,224,552
Messages
6,179,488
Members
452,917
Latest member
MrsMSalt

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top