Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old May 5th, 2011, 10:56 AM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

do you have a "Dim" statement for "cell" ?
 
Old May 5th, 2011, 11:01 AM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

Dimming "cell" as a range object, I just ran it on my computer and it works fine, can you post all your code?
 
Old May 5th, 2011, 11:07 AM
Friend of Wrox
 
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Default

Hi

no probs. i ahve posted my entire macro...its quite big and does mutliple thinsg but i ahve highlighted the part you ahve been helping me with

Code:
Option Explicit
Dim stFormatStyle, stResult As String
Dim iStart, iEnd, iDigitsAfterDecimalPoint, iDecimals As Integer
Dim bIsPercentage As Boolean

Sub PP3InputRefV2()

'#############################################################################################################
'JS 05/05/2011
'Creates and populates the Input Reference table for Honda Germany Profit Planner iii
'#############################################################################################################

Dim StrFldr, c00, stCurrentStyle, bVNum, bImport, bVImport As String
Dim bSuggestvImport, bSuggestVNum As Integer
Dim PPWB, PPNew, PPOld As Workbook
Dim PPNewIR, PPWBForm As Worksheet
Dim Nrow, NCol As Long
Dim cell, cells As Range
Dim sq, sht, sht2 As Variant
Dim Startime, Endtime As Double

'Gather Inport and Convert version numbers and determine if manually data is to be imported
bVNum = Application.InputBox("Please enter the version number you wish to convert", "Version convert Entry Box", bSuggestVNum)
bImport = MsgBox("Do you want to import old version?", vbQuestion + vbYesNo, "???")
    If bImport = vbYes Then 'if user selects yes it will ask what version they want to use
        bVImport = Application.InputBox("What version do you want to import", "Year Entry Box", bSuggestvImport)
    End If
    
Startime = Timer

'Define Variables
StrFldr = "R:\HondaCarsEurope\Markets\Germany\PPIII\Tables"
Set PPWB = Workbooks.Open(StrFldr & "\" & "HDE_PPIII_MONTH_Input_Reference_Form_V" & bVNum & ".xlsx")
Set PPWBForm = PPWB.Sheets("PPIIIFORM")
Set PPNew = Application.Workbooks.Add
PPNew.Sheets.Add.Name = ("InputRefAPD")
Set PPNewIR = PPNew.Sheets("InputRefAPD")

'Add headerlines to Input Reference sheet
PPNewIR.Select
NCol = 1
PPNewIR.cells(NCol, 1).Resize(, 25).Value = Array("InputReference", "Department", "Category", "Section", "DeptVisible", "InputReferenceOrder", _
"LineReference", "LineDescription", "InputDescription", "Format", "Currency", "ColPos", "Input", "InPP", _
"FormulaOverwrite", "Seasonal", "Divide", "Equals", "SectionOverwrite", "LineDescriptionOverwrite", _
"LineJumpReference", "LineJumpText", "HelpText", "ValidationOrder", "Benchmark")

'Loop through cell range in Form and populate Input Reference table
Nrow = 2
For Each cell In PPWBForm.Range("F4:U644")
    If cell.Value <> "" Then
        PPNewIR.cells(Nrow, 1).Value = cell.Value
        PPNewIR.cells(Nrow, 2).Value = PPWBForm.Range("A" & cell.Row)
        PPNewIR.cells(Nrow, 3).Value = PPWBForm.Range("B" & cell.Row)
        PPNewIR.cells(Nrow, 4).Value = PPWBForm.Range("C" & cell.Row)
        PPNewIR.cells(Nrow, 5).Value = "True"
        PPNewIR.cells(Nrow, 7).Value = PPWBForm.Range("D" & cell.Row)
        PPNewIR.cells(Nrow, 8).Value = PPWBForm.Range("E" & cell.Row)
        PPNewIR.cells(Nrow, 10).Value = PPWBForm.Range("E" & cell.Row).Value & " - " & PPWBForm.Range(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cell.column, 1) & "1").Value
        PPNewIR.cells(Nrow, 11).Value = fTryThis(cell)        PPNewIR.cells(Nrow, 12).Value = cell.column - 5
        PPNewIR.cells(Nrow, 13).Value = Not cell.Interior.Color = RGB(217, 217, 217)
        PPNewIR.cells(Nrow, 14).Value = "True"
        PPNewIR.cells(Nrow, 15).Value = cell.Interior.Color = RGB(255, 255, 0)
        PPNewIR.cells(Nrow, 16).Value = PPWBForm.Range("V" & cell.Row)
        PPNewIR.cells(Nrow, 17).Value = PPWBForm.Range("W" & cell.Row).Value
        PPNewIR.cells(Nrow, 18).Value = PPWBForm.Range("X" & cell.Row).Value
        PPNewIR.cells(Nrow, 19).Value = PPWBForm.Range("Y" & cell.Row).Value
        PPNewIR.cells(Nrow, 20).Value = PPWBForm.Range("Z" & cell.Row).Value
        PPNewIR.cells(Nrow, 21).Value = PPWBForm.Range("AA" & cell.Row).Value
        PPNewIR.cells(Nrow, 22).Value = PPWBForm.Range("AB" & cell.Row).Value
        Nrow = Nrow + 1
        Application.StatusBar = cell.Address
    End If
    
Next cell

PPWB.Close

If bImport = vbYes Then 'if the user selected yes to the question at the start
    'Opens perious version doc entered and copy data into temp sheet and closes it
    Application.StatusBar = "Importing previous version data"
    Set PPOld = Workbooks.Open(StrFldr & "\" & "HDE_PPIII_MONTH_Input_Reference_Form_V" & bVImport & ".xlsx")
    PPNew.Sheets.Add.Name = "ConvertManual"
    PPOld.Sheets("InputRefapd").cells.Copy Destination:=PPNew.Sheets("ConvertManual").Range("A1")
    PPOld.Close
    'Loops through column in
    For Each cell In PPNewIR.Range("A2:A3000")
        If cell.Value <> "" Then
          PPNewIR.cells(Nrow, 6).Value = Application.WorksheetFunction.VLookup(cell.Value, PPNew.Sheets("ConvertManual").Range("A2:Y3000"), 10, False)
          PPNewIR.cells(Nrow, 10).Value = Application.WorksheetFunction.VLookup(cell.Value, PPNew.Sheets("ConvertManual").Range("A2:Y3000"), 10, False)
          PPNewIR.cells(Nrow, 21).Value = Application.WorksheetFunction.VLookup(cell.Value, PPNew.Sheets("ConvertManual").Range("A2:Y3000"), 21, False)
          PPNewIR.cells(Nrow, 22).Value = Application.WorksheetFunction.VLookup(cell.Value, PPNew.Sheets("ConvertManual").Range("A2:Y3000"), 22, False)
          PPNewIR.cells(Nrow, 23).Value = Application.WorksheetFunction.VLookup(cell.Value, PPNew.Sheets("ConvertManual").Range("A2:Y3000"), 23, False)
        End If
        Application.StatusBar = cell.Address
    Next cell
Application.StatusBar = "Formatting and deleteing temporary Sheet"
PPNewIR.Select: PPNewIR.cells.Copy: PPNewIR.PasteSpecial Paste:=xlPasteValues
PPNew.Sheets("ConvertManual").Delete
End If

Application.StatusBar = "Formatting"
PPNewIR.Select: PPNewIR.cells.Copy: PPNewIR.Range("A1").Select: Selection.PasteSpecial Paste:=xlPasteValues
For Each sht2 In Array("Sheet1", "InputRefapd")
    PPNew.Sheets(sht2).Select: Range("A1").Select
Next

Application.StatusBar = "Saving"
PPNew.SaveAs StrFldr & "\" & "HDE_PPIII_Input_Reference_Table_MONTH_" & bVNum & ".xlsx"

Endtime = Timer - Startime
Application.StatusBar = "Macro Finished in " & Endtime
End Sub
Function fTryThis(Target As Range) As String

    'reset iDigitsAfterDecimalPoint
    iDigitsAfterDecimalPoint = 0
    
    'get 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
        fTryThis = "%10.0f%%"
        Exit Function
    End If
    
    'if the format style is "comma", find the number of digits after decimal and return the string
    'this is what the NumberFormat string looks like for a "comma" format:
        '   _(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)
    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
        fTryThis = "%10." & iDigitsAfterDecimalPoint & "f%"
        'exit the function
        Exit Function
    End If
    
    'this looks at the last character of the NumberFormat string and if it's a percentage sign, then sets a Boolean to true (this will be used later to put an extra "%" sign on the return string if need be
    If Right(stFormatStyle, 1) = "%" Then
         bIsPercentage = True
    Else
         bIsPercentage = False
    End If
    'find the decimal point position:
    iStart = InStr(stFormatStyle, ".")
    
    If iStart = 0 Then 'there is no period
        iDigitsAfterDecimalPoint = 0
    Else 'there is a period
        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
    'Now you should have all the pieces you need so just put it together:
    stResult = "%10." & iDigitsAfterDecimalPoint & "f%"
    If bIsPercentage Then stResult = stResult & "%"
    
    'return the string
    fTryThis = stResult
End Function
 
Old May 5th, 2011, 11:15 AM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

Don't know if this is what the problem is, but you're declaring "cell" as a variant, not as a range:
Code:
'here cell is a variant
Dim cell, cells As Range

'try this:
Dim cell as range, cells As Range
other than that possibility, not sure why it's not working
The Following User Says Thank You to mtranchi For This Useful Post:
jeskit (May 5th, 2011)
 
Old May 5th, 2011, 11:19 AM
Friend of Wrox
 
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Talking

YAY it works so much happier now! i can stop banging my head against the desk now!!

THANK YOU SOOOO MUCH

I am incredible greatful for you help!!

 
Old May 5th, 2011, 11:23 AM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

lol, glad i could help, know the feeling of banging one's head against the wall.

I'd suggest going through all your variables and declaring them explicitly like you did with "cell."

Also, I'd strongly suggest renaming your "cells" variable to perhaps "rgCells" because that name is the same as VBA's "Cells()" object.





Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel Cell Format sumith ASP.NET 2.0 Professional 0 January 5th, 2010 05:34 AM
Checking an ICQ number SKYDOS BOOK: Beginning Regular Expressions 3 November 9th, 2008 03:55 PM
Checking cell value is integer ozPATT Excel VBA 2 October 5th, 2005 06:43 AM
Checking for upper,lower case, number and symbol dumbdumb SQL Server 2000 1 March 18th, 2004 03:51 AM
Checking for a number aware Classic ASP Basics 5 June 5th, 2003 09:57 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.