Dim statement for sheet Results

I am trying to get this sub to look at a variable workbook as indicated by Dim ex As Variant. I have this working, now I am having a problem with this statement:

rngFind = Windows(ex).Range("A2:A" & End_Row).Find(what:=lookVal)

I get this runtime error: Object doesn't support this property or method

With the debugger the ex is showing the correct workbook and lookVal is showing the correct value. I'm guessing it is not liking the .Range("A2:A" & End_Row). As End_Row is showing a 0.

I am having the user enter the loan number to be searched for in a textbox, then once the command button is pressed the code needs to search the ex workbook for the loan number and pull cetain data from it into the user form (which I have had working) and if the lookVal is not found use a Msgbox.

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim ex As Variant
    Dim lookVal As Variant
    Dim rngFind As Range
    Dim End_Row As Long

    ex = Me.lblExtract.Caption

    lookVal = Me.txtLoanNumber.value

    rngFind = Windows(ex).Range("A2:A" & End_Row).Find(what:=lookVal)

    End_Row = Range("A" & Rows.Count).End(xlUp).Row


    If rngFind Is Nothing Then
        'not found
        MsgBox "Sorry, that loan number was not found in the list!", vbInformation, "ERROR!"
        With Me.lblCPB
            .Caption = rngFind.Offset(0, 10).Text
        End With
        With Me.lblNoteType
            .Caption = rngFind.Offset(0, 20).Text
        End With
        With Me.lblHoldCodes
            .Caption = rngFind.Offset(0, 85).Text
        End With
        With Me.lblServiceType
        If rngFind.Offset(0, 90).Text = "1" Then
            .Caption = "Master Serviced"
        End If
        If rngFind.Offset(0, 90).Text = "L" Then
            .Caption = "Limited Serviced"
        End If
        If rngFind.Offset(0, 90).Text = "" Then
            .Caption = "Primary Serviced"
        End If
        End With
    End If
    Application.ScreenUpdating = True

End Sub
I can't hard code the workbook as this form is used to copy data from one variable workbook to a separate variable workbook (which is working)

I am just working on validation for the loan number that is entered.

Thanks for your help!

I am working out the problems with a userform and I have come across one that I do not know how to handle.

Private Sub cmdGetExtract_Click()
    Dim End_Row As Long
    lblExtract.Caption = ActiveWorkbook.Name
    With Me.cboLoanNumber
        End_Row = Range("A" & Rows.Count).End(xlUp).Row
        ListItems = Worksheets("Borrower,Master,ARM").Range("A2:A" & End_Row).value
        ListItems = Application.WorksheetFunction.Transpose(ListItems)
        ' convert values to a vertical array
        For i = 1 To UBound(ListItems)
            .AddItem ListItems(i)
        Next i
        .ListIndex = -1
    End With

End Sub
I am setting up a form to select 2 open workbooks to copy information from one to the other. This code here is basically the first step that the user will perfom once the form is open. The user will make the workbook active that the data is to be copied from. It will set the caption for lblExtract and then populate the cboLoanNumber.

Now if the user has the wrong workbook active when the cmdGetExtract is pressed I get a subscript out of range because it will not find the Sheet "Borrower,Master,ARM" to populate the combobox.

How can I set up an If statement with a MsgBox "Please Select the Extract", vbExclamation, "ERROR!" if the workbook that is the active workbook does not have a Sheet named "Borrower,Master,ARM"?

Thanks for your help!

Hi i have an sql query that i can run. The first macro below works perfectly. It runs a sql statement in excel and pastes the outcome into an excel sheet. I then lookup the information that i need to return it to a set template.

I now have the sql statement in vba. I now want to skip the step of bring it into excel and doing the lookups. So i want to store it in vba "space" and do the look up there. Could some body give me pointers. The second macro below brings the query in to the excel sheet via vba.

HTML Code:
Sub GetOpicsData()
Dim FixedDataDates As Collection
Dim FixedDataPrin As Collection
Dim FixedDataRates As Collection
Dim FloatDataDates As Collection
Dim FloatDataPrin As Collection
Dim FloatDataRates As Collection
Set FixedDataDates = New Collection
Set FixedDataPrin = New Collection
Set FixedDataRates = New Collection
Set FloatDataDates = New Collection
Set FloatDataPrin = New Collection
Set FloatDataRates = New Collection
Worksheets("Opics Data").Select
    Selection.QueryTable.Refresh BackgroundQuery:=False
    Worksheets("Opics Query").Select
    Range("b26:b500").NumberFormat = "dd/mm/yyyy;@"
    Range("d26:d500").NumberFormat = "dd/mm/yyyy;@"
    Range("c26:c500").NumberFormat = "#,##0"
    Range("e26:e500").NumberFormat = "#,##0"
i = 1
dealno = Worksheets("Opics Data").Cells(1001, 2)
curr = Worksheets("Opics Data").Cells(1001, 8)
portf = Worksheets("Opics Data").Cells(1001, 10)
costc = Worksheets("Opics Data").Cells(1001, 11)
deald = Worksheets("Opics Data").Cells(1001, 12)
matd = Worksheets("Opics Data").Cells(1001, 13)
trads = Worksheets("Opics Data").Cells(1001, 16)
lvalue = Worksheets("Opics Data").Cells(1001, 14)
While Worksheets("Opics Data").Cells(1000 + i, 6)  ""
If Worksheets("Opics Data").Cells(1000 + i, 6) = "FIXED" Then
fixeddayc = Worksheets("Opics Data").Cells(1000 + i, 4)
If Worksheets("Opics Data").Cells(1000 + i, 7) = "" Then
If Worksheets("Opics Data").Cells(1001 + i, 7) >= Date Then FixedDataDates.Add Worksheets("Opics Data").Cells(1000 + i, 15)
 If Worksheets("Opics Data").Cells(1001 + i, 7) >= Date Then
 FixedDataDates.Add Worksheets("Opics Data").Cells(1000 + i, 7)
''If Worksheets("Opics Data").Cells(1002 + i, 7) = Date Then
FixedDataRates.Add Worksheets("Opics Data").Cells(1000 + i, 5)
FixedDataPrin.Add Worksheets("Opics Data").Cells(1000 + i, 9)
If Worksheets("Opics Data").Cells(1002 + i, 7) = Date Then
FloatDataDates.Add Worksheets("Opics Data").Cells(1000 + i, 15)
floatrate = Worksheets("Opics Data").Cells(1001 + i, 5)
End If
If Worksheets("Opics Data").Cells(1001 + i, 7) >= Date Then
FloatDataDates.Add Worksheets("Opics Data").Cells(1000 + i, 7)
If Worksheets("Opics Data").Cells(1002 + i, 7)

What is wrong with this statement?

lookVal = ActiveSheet.Range("K7").value

It seems like it is not getting the cell value to use for the lookVal.

I am getting runtime error 91 object variable or with block.variable not set.

Here is my code
Sub Look_Up_Town_Code()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim rngFind As Range
    Dim lookVal As Variant
    Dim SourceWB As Workbook

'    lookVal = ActiveWorkbook.Sheets("Analyst Property").Range("K7").value
    lookVal = ActiveSheet.Range("K7").Text
    Set SourceWB = Workbooks.Open _
    ("N:AnalystAnalyst Template CodesStrategy County Codes.xls", _
            False, True)

    Set rngFind = SourceWB.Range("A2:A" & ws.Rows.Count).Find(what:=lookVal)

    If rngFind Is Nothing Then
        'not found
        MsgBox "Sorry, Town Code not found!", vbInformation, "ERROR!"
        'found, rngfind range variable is now set to the found cell
        MsgBox "Loan #: " & rngFind.Offset(0, 0).value & vbNewLine & _
               "Town" & rngFind.Offset(0, 1).value & vbNewLine & _
               vbInformation, "Town Code"

    End If

        SourceWB.Close False ' close the source workbook without saving changes
        Set SourceWB = Nothing

        Application.ScreenUpdating = True
End Sub
Thanks for your help.

This is the same post as I put at Dreamboat's. They gave nothing on this, so I'm presenting it to you big guns:

To fix the "Cannot shift objects off sheet" problem I want to change all of a sheet's comments. I am weak with objects. I know I want to do
.Comment.Shape.Placement = xlMoveAndSize
but my problem is the object to apply this to and the For statement. Can you help?

Again: I want to change .Comment.Shape.Placement on each comment. Code:
Sub Macro2()
Dim obj As Object
'Dim obj As Comment
  On Error Resume Next
  For Each obj In ActiveSheet.Shapes
    obj.Comment.Shape.Placement = xlMoveAndSize
End Sub

Here's the setup...

I have 2 macros right now that hide/unhide specific rows and columns. I only want these to run on certain sheets. Right now there's about 7, but that can change going forward. I don't mind hardcoding the sheet names into the code, but don't want to have some sort of huge nested IF statement. I know the code below should loop thru all worksheets, but is there any way to make the collection a set group of worksheets?

Sub AllHide()

    Dim WkSht As Worksheet
    For Each WkSht In ActiveWorkbook.Worksheets
        Call HideRows
        Call HideColumns
    Next WkSht

End Sub

Hi there! First of all let me state this is a great forum and I have learned a lot. To those of you who answer questions: Thanks a lot!

I have a sheet with multiple kinds of data. What I am trying to do is write a macro that will look at the dates in a certain column and delete the corresponding row if the data is after a certain date. I would also like rows with blank cells in the same column to be deleted. For instance:

BARRON UNIT # 8H 22-Feb-087432BARRON UNIT # 9H 22-Feb-087537BARRON UNIT #10H 28-Feb-087391BARRON UNIT #1H 23-Jan-077560BARRON UNIT #2H 04-Dec-067553BARRON UNIT #3H 17-Jul-077552BEASLEY #1 02-Nov-036725BEASLEY UNIT #2H 26-Jan-066679BECKHAM UNIT # 2H BECKHAM UNIT # 3H 0BECKHAM UNIT # 4H 0BECKHAM UNIT # 5H

All rows with a data less than or equal to 12/31/08 or blanks I want the rows to be deleted. So, in this case, only the first 3 rows would be left after the macro.

Here's the code I have so far:

Sub test()
' test Macro
' Macro recorded 4/9/2008 by jholsworth
Dim NumRows, iLine As Integer
'Select the usedRange
'Get the Number of the rows used
    NumRows = ActiveSheet.UsedRange.Rows.Count
'Delete all rows where CGID in Column D is blank or

Hello all,

I have a likely simple problem. I have a worksheet that emials a notice to myself when a certain value is exceeded. It works good but I need to be able to have my macro now count the number of OK's in the columns C:AA in the row that my identifier is in . (the offsets are not right as I have trimmed the example to omit the whole sheet)

really all I need direction for is the Countif function syntax unless you can not have a variable in the countif statement, then any other direction would be greatly appreciated:



Here is my code that I need to have the correct syntax for.

Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim St_alvalue, LL, UL, ND, RC, SA, OC
Dim numsta As Integer
Dim col As Range

Sub Alarm_EMail()

St_alvalue = Application.Match(Worksheets("QC").Range("E35").Value, Worksheets("ADMIN").Range("A1:A200"), 0) ' finds the correct row to be examined (works good)

numsta = Application.WorksheetFunction.CountIf(St_alvalue, "OK") 'Here is the problem. I need to count the number of "OK" text inbetween columns P:AA on St_alvalue Worksheets("ADMIN")

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

With Sheet4.Range("A1:AA1000")

LL = .Find(What:=Worksheets("QC").Range("E35").Value, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 15)

UL = .Find(What:=Worksheets("QC").Range("E35").Value, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 16)

ND = .Find(What:=Worksheets("QC").Range("E35").Value, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 17)

RC = .Find(What:=Worksheets("QC").Range("E35").Value, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 18)

SA = .Find(What:=Worksheets("QC").Range("E35").Value, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 19)

OC = .Find(What:=Worksheets("QC").Range("E35").Value, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 20)

End With

strbody = "" & Worksheets("QC").Range("E35").Value & " has had the following RTQ data alarms triggered:" & vbNewLine & vbNewLine & _
"" & Worksheets("admin").Range("P1").Value & " Status: " & LL & vbNewLine & _
"" & Worksheets("admin").Range("Q1").Value & " Status: " & UL & vbNewLine & _
"" & Worksheets("admin").Range("R1").Value & " Status: " & ND & vbNewLine & _
"" & Worksheets("admin").Range("S1").Value & " Status: " & RC & vbNewLine & _
"" & Worksheets("admin").Range("T1").Value & " Status: " & SA & vbNewLine & _
"" & Worksheets("admin").Range("U1").Value & " Status: " & OC & vbNewLine & ""

With iMsg
Set .Configuration = iConf
.To = "myself"
.CC = ""
.BCC = ""
.From = """Alarm"" "
.Subject = "" & Worksheets("QC").Range("E35").Value & " Data Alarm "
.TextBody = strbody
End With

End Sub

Hey all...I've never used Select Case before, but I like the idea and think it fits my need well...but there's definitely something I'm not getting...

So in the following macro I'm trying to walk down an excel spreadsheet and populate data to specific tables in a word document. I've got it working if I hard code the tables (as a test).
I walk down the spreadsheet with LoopRng and evaluate every row (its address) against known addresses in the list (they are known through a .find)...that's all working.
For example B2 to B30 is one section to be populated to table 7
while B31 to B75 is a section to be populated to table 2...and so on.

I'm trying to use the Select Case to tell the macro to populate different Word tables based on where LoopRng is. So if LoopRng is at any cell between B2 and B30 then it should be populating table 7, but once LoopRng hits B31 it should begin populating table8:

Sub PopulateROCDoc()
' Populate DOC from Assessment Worksheet Macro

'Declare the Word Variables
Dim oWord As Word.Application
Dim oTbl As Word.Table
Dim oCell As Word.Range
Dim i As Integer
Dim CaseCt As Integer

'Declare Assessment Wksht variables
Dim LoopRng As Range
Dim MacroEnd As Range
Dim TableCt As Integer

Dim Req1 As Range
Dim Req2 As Range
Dim Req3 As Range
Dim Req4 As Range
Dim Req5 As Range
Dim Req6 As Range
Dim Req7 As Range
Dim Req8 As Range
Dim Req9 As Range
Dim Req10 As Range
Dim Req11 As Range
Dim Req12 As Range

Worksheets("Assessment Worksheet").Activate

'Initialize variables - column b is used because A has merged and blank cells
Set LoopRng = Sheets("Assessment Worksheet").Range("b2")
Set Req1 = LoopRng

'Initialize CaseCt to reset Word table Cell rows dynamically
CaseCt = 7

With Range("b1:b1000")
  Set MacroEnd = .Find("12.10.4", LookAt:=xlPart).Offset(1, 0)

    'These ranges define the start of each requirement section
    Set Req2 = .Find("2.1", LookAt:=xlPart)
    Set Req3 = .Find("3.1", LookAt:=xlPart)
    Set Req4 = .Find("4.1.a", LookAt:=xlPart)
    Set Req5 = .Find("5.1", LookAt:=xlPart)
    Set Req6 = .Find("6.1.a", LookAt:=xlPart)
    Set Req7 = .Find("7.1", LookAt:=xlPart)
    Set Req8 = .Find("8.1", LookAt:=xlPart)
    Set Req9 = .Find("9.1", LookAt:=xlPart)
    Set Req10 = .Find("10.1", LookAt:=xlPart)
    Set Req11 = .Find("11.1.a", LookAt:=xlPart)
    Set Req12 = .Find("12.1", LookAt:=xlPart)
        'Set the Word variable (runs new instance of Word).
        Set oWord = CreateObject("Word.Application")

'Select and open the  Doc Template

        DOCTemplate = Application.GetOpenFilename(Title:="Please select the ROC doc template")
            If DOCTemplate = False Then
            ' They pressed Cancel
            MsgBox "Stopping because you did not select a file"
            MsgBox DOCTemplate
            Exit Sub
                'Open the Word Template document in visible mode.
                With oWord
                .Visible = True
                .Documents.Open Filename:=DOCTemplate
                End With
            End If

            '*****TO DO--> Open Save-AS dialog box
            ' oWord.ActiveDocument.SaveAs Filename:=ROCDOCTemplate & "1"

'Testing hard coded tables and rows
                            With oWord
                            'Populate IP, NIP, TarDt/Cmnts
                            '*****TO DO --> ONCE CONFIRMED, MAKE ROW '3' BE DYNAMIC COUNTER
                            Set oTbl = .ActiveDocument.Tables(9)
                            oTbl.Cell(3, 3).Range.Text = "tesing 2 3"
                            oTbl.Cell(3, 4).Range.Text = "testing 2 4"
                            oTbl.Cell(3, 5).Range.Text = "testing 2 5"
                            End With
'end hard code test

Do Until LoopRng.Address = MacroEnd.Address
                Select Case LoopRng.Address
                    'Req 1
                    Case Req1.Address To Req2.Offset(-1, 0).Address: TableCt = 7
                    'Req 2
                    Case Req2.Address To Req3.Offset(-1, 0).Address: TableCt = 8
                    'Case LoopRng.Address < Req4.Address: TableCt = 9
                    'Case LoopRng.Address < Req5.Address: TableCt = 10
                    'Case LoopRng.Address < Req6.Address: TableCt = 11
                    'Case LoopRng.Address < Req7.Address: TableCt = 12
                    'Case LoopRng.Address < Req8.Address: TableCt = 13
                    'Case LoopRng.Address < Req9.Address: TableCt = 14
                    'Case LoopRng.Address < Req10.Address: TableCt = 15
                    'Case LoopRng.Address < Req11.Address: TableCt = 16
                    'Case LoopRng.Address < Req12.Address: TableCt = 17
                    'Case LoopRng.Address < MacroEnd.Address: TableCt = 18
                    Case Else
                        MsgBox "There was an error defining ROC Doc input talbes; Macro aborted"
                        Exit Sub
                End Select
                'MsgBox PopRng.Address
                        ' This If statement captures when a Case (or req) changes so that the dynamic row
                        ' count can be reset back to the top of the next table to be populated.
                        If CaseCt = TableCt - 1 Then
                        i = 3
                        CaseCt = CaseCt + 1
                        End If
                            'Populate ROC Doc tables and cells
                            With oWord
                            'Populate IP, NIP, TarDt/Cmnts
                            '*****TO DO --> ONCE CONFIRMED, MAKE ROW '2' BE DYNAMIC COUNTER
'????would this be of syntax otbl.cell(i.3).range.text?????

                            Set oTbl = .ActiveDocument.Tables(TableCt)
                            oTbl.Cell(3, 3).Range.Text = LoopRng.Offset(0, 3).Value
                            oTbl.Cell(3, 4).Range.Text = LoopRng.Offset(0, 4).Value
                            oTbl.Cell(3, 5).Range.Text = LoopRng.Offset(0, 9).Value
                            End With
                    i = i + 1
                    Set LoopRng = LoopRng.Offset(1, 0)
Thanks for any help...i'm curious

I have a Var called MyGetRange which is equal to PP??? where ??? is the is the 'named range' for the month I have selected on a different sheet and pasted to the active sheet starting at Row 7.

Goal: Row 7 is to be a simple header describing the pasted range. I wish to change the value in A7 of the Activesheet to reflect which month has been pasted.

I am a bit new to CASE SELECT METHOD. In the following code I have tried unsuccessfully to check the value of MyGetRange to see which Monthly Title is to later be pasted into A7. After an hour of dinking around, I am still perplexed. The MsgBox following End Case continues to return an empty value. Boo.

Somebody HEP my please!

' Change Header For Pasted "Month" range
    'Use Case Statement To Determine NewHeader
        Dim NewHeader As String
        Dim AEName As String
        AEName = Sheets("SALES").Range("AH2").Value
        Select Case NewHeader
            Case MyGetRange = "PPJan"
                NewHeader = "January 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPFeb"
                NewHeader = "February 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPMar"
                NewHeader = "March 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPApr"
                NewHeader = "April 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPMay"
                NewHeader = "May 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPJun"
                NewHeader = "June 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPJul"
                NewHeader = "July 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPAug"
                NewHeader = "August 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPSep"
                NewHeader = "September 2008 1st Half Commission For " & AEName
            Case MyGetRange = "PPOct"
                NewHeader = "October 2008 1st Half Commission For For " & AEName
            Case MyGetRange = "PPNov"
                NewHeader = "November 2008 1st Half Commission For Ben Larson"
            Case MyGetRange = "PPDec"
                NewHeader = "December 2008 1st Half Commission For Ben Larson"
        End Select
        MsgBox NewHeader

I have a Workbook with multiple sheets that a use has to select a specific loan number and then copy a range of cells from each sheet into another workbook. What I want is the user to enter the loan number that is needed, have the code start with the first sheet find the loan number and then select the range of cells for that loan, then go to the second sheet, find the loan and select the range that will be copied. Etc.

I have this code from another project that I have worked on and was hoping that it could be used for this purpose. I would like to keep the userform with the comboBox.

Private Sub cmdFind_Click()
' User enters the desired Loan Number into the ComboBox and clicks OK

    Dim ws As Worksheet, rngFind As Range, lookVal As Variant

    Set ws = Worksheets("Borrower,Master,ARM")
    lookVal = Me.cboLoanNumber.Value

    Set rngFind = ws.Range("A2:A" & ws.Rows.Count).Find(What:=lookVal)
    Unload Me
    'Checking if we found anything or not with the Find method
    If rngFind Is Nothing Then
        'not found
        MsgBox "Sorry, that loan number was not found in the list!", vbInformation, "ERROR!"

    End If
End Sub
I hope that after the Else statement that the range I need could be selected and then move onto the next sheet, etc through the workbook and at the end on each sheet that is used to copy info over to the users workbook the range of cells will be selected on each sheet for easy copy and paste.

I need the code to be able to handle duplicates as only the first sheet will not have dups. All the remaining sheets may have dups on it and all the rows containing the duplicates will need to have the range copied.


I am having some trouble with the MS KB fix.

The issue code is in red. Now if I supply a Set oBook = Application.Workbook.close any where in the code I get a Compile Error "Expected Function or Variable". Now if I remove it I get a Runtime error of 91 on the line in blue.

Any help would be great.

Here is my code

Private Sub CommandButton1_Click()
Dim i As Long
Dim oBook As Workbook
Dim strIfStatement As String
''First We save!!
ThisWorkbook.SaveAs Filename:="C:MDSE_SRCL_SchoolCreated.xls"
'' Now Lets creat the school scheets
For i = 1 To Sheets("Create_Schools").Range("G16")
'' Begin run-time error 1004 fix
   If i Mod 30 = 0 Then
        Set oBook = Application.Workbooks.Close
        oBook.Close SaveChanges:=True
        Set oBook = Nothing
        Set oBook = Application.Workbooks.Open("C:MDSE_SRCL_SchoolCreated.xls")
   End If
'' End run-time error 1004 fix
'' Now lets copy the sheets # of times and then rename them.
    Sheets("x_copy").copy before:=Sheets(Sheets.Count)
    ActiveSheet.Name = "School" & i
    ''  This next line below is the code for updating the IF statements on the Network Assessment tab:
    ''  The formula for the IF statement is:
    ''      =IF(x_copy!E$5="Exceeds Available WAN Bandwith", "Exceeds Available WAN Bandwith", "Within Available WAN
    ''  To build that formula dynamically, we need to replace "x_copy" with each worksheet's name:  "School" & CStr(i)
    ''  and replace the double quotation marks with either double-double quotes ("") or use Chr(34).
    ''  Then we update the cells in the range G13:G237 on the Network Assessment tab starting with the first cell
    ''  in that range and continuing down the column for each School tab that was just created:  Cells(i, 1).
    '' Now lets copy the if statment to all the notify cells on the Network Assessment Tab
    Sheets("Network Assessment").Range("G13:G237").Cells(i, 1).Formula = "=IF(School" & CStr(i) & "!E$5=" & Chr(34) &
"Exceeds Available WAN Bandwith" & Chr(34) & ", " & Chr(34) & "Exceeds Available WAN Bandwith" & Chr(34) & ", " & Chr(34) &
"Within Available WAN Bandwith" & Chr(34) & ")"
    Sheets("Network Assessment").Range("E10").Cells(i, 1).Formula = "=SUM(School1:School" & CStr(i) & "!C8)"
Next i
'' This will clean out the left over Notify Cells on the Network Assessment tab.
''  If you want to clean up the formulas in the remaining cells below the last School, you can use this loop:
For i = (Sheets("Create_Schools").Range("G16") + 1) To 225
    Sheets("Network Assessment").Range("G13:G237").Cells(i, 1).Formula = ""
Next i
'' For simplicty lets hid both the orginal school tab (x_copy) and The Create_School Tab.
Sheets("x_copy").Visible = False
Sheets("Create_Schools").Visible = False
'' Now that we are done lets save once agian.
ThisWorkbook.SaveAs Filename:="C:MDSE_SRCL_SchoolCreated.xls"
End Sub

I am pretty new to arrays in VBA. Is it possible to have a variable array kind of like this?

Sub testArray()
Dim myArray As Variant
Dim addOnA, addOnArray As String
Dim Sht As Object
addOnArray = Chr(34) & Chr(34)
For Each Sht In ActiveWorkbook.Worksheets
    addOnA = Sht.Name
    addOnArray = addOnArray & "," & Chr(34) & addOnA & Chr(34)
Debug.Print addOnArray

myArray = Array(addOnArray)
For i = 1 To UBound(myArray)
    Debug.Print myArray(i)
Next i

End Sub
I am pulling in directory names with the following code and if a sheet name does not exist for the directory name, create the sheet with the directories name:
Sub updateTSMxls()
With ActiveWorkbook
    Dim fso As New FileSystemObject
    Dim flds As Folders
    Dim strFname As String
    Dim Sht As ObjectDim noShtsAdded As Integer
    Set flds = fso.GetFolder("server").SubFolders

noShtsAdded = 0
    For Each f In flds
        strFname = f.Name
        If Val(strFname) > 0 Or strFname = "000-999" Then
            For Each Sht In .Worksheets
                If Sht.Name  strFname Then
                    .ActiveSheet.Name = strFname
                    noShtsAdded = noShtsAdded + 1
                End If
        End If
End With
MsgBox noShtsAdded
End Sub
I know that my "For Each/Next" loops and my If statement aren't allowing me to properly check agains each other and my first thought was to build a variable array of the directories then do a "For Each/Next" with an If statement to check for an existing sheet name. Am I headed in the wrong direction or is this just not possible (the first part)?

Hi All,

In the the following code is designed to open a bunch of external workbooks and paste in relevant values from the workbook that the code is stored in (Worksheet name "Parameters").

Sub Change_Int() 
    Dim shtUse As Worksheet 
    Dim Int_Sheet As String 
    Set shtUse = ThisWorkbook.Sheets("Parameters") ' Use this sheet i.e. 'shtUse' to open and update all relevant workbooks.
    For Int_Sheet = 13 To 13 
        Int_Sheet = shtUse.Cells(rows, 4) & "FOMIC05_" & shtUse.Cells(rows, 3) & "_" & shtUse.Cells(6, 3) & ".xls" 
        Debug.Print Int_Sheet 
        If Not Int_Sheet Is Nothing Then 
            Workbooks.Open Filename:=Int_Sheet, UpdateLinks:=0 
            ActiveWorkbook.Sheets("Section 2 - Summary").Select 
            Set c = Selection.Find(Format(shtUse.Range("C8").Value, "mmm-yy"), After:=ActiveCell, LookIn:=xlValues, _ 
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
            MatchCase:=False, SearchFormat:=False) 
            Debug.Print c 
            If Not c Is Nothing Then 
                c.Offset(8, 0).Select 
                Selection.PasteSpecial Paste:=xlPasteFormulas 
            End If 
            ActiveWorkbook.Sheets("Section 1 - Intro").Select 
            Set Curr = Range("E13") 
            Selection.PasteSpecial Paste:=xlPasteValues 
        End If 
    Next rows 
End Sub
I've tried to add validation to ceck that the workbook exists before trying to open it, in the line:

This however gives a Compile Error "Type Mismatch" and highlights Int_Sheet as the source of the error.

What is wrong with this statement, I;ve used the "If Not [variable] is Nothing" Code later on and it works fine for that (I've tested that part and confirmed).

Could anyone please help explain and amend the error.



I am trying to write a macro to generate charts which will update on a daily basis.
I created a Chart object variable named DropChart. Next I added a new chart in my workbook and set DropChart as this new chart.
Sourcebook is the object variable I used for my source data.
I am able to generate the chart.
However, when I use HasTitle property, it gives me an error saying "Object does not support this property or method". I think I am using the right hierarchy in the With statement. Can someone help me understand this? This is my first time writing a code involving charts.

Dim DropChart As Chart
Set DropChart = Workbooks("Daily_Trending_Report.xls").Charts.Add
DropChart.SetSourceData Source:=Sourcebook.Sheets("PHIL1").Range( _
        "AH7:AH37,A7:A37"), PlotBy:=xlColumns
With Workbooks("Daily_Trending_Report.xls").DropChart
    .HasTitle = True
    .ChartTitle.Text = "Drops (% and Counts)"
End With

So if the cell value in A9 = 0 I want the macro to skip over the rest of the code and end at the bottom. How can do this? Here is my code:

Sub Calculate()
StartTime = Timer
Application.ScreenUpdating = False 'Turns off screen refreshing
Application.StatusBar = "Working..."
Dim lastrow As Long

With Sheets("Project Insight Data").Select 'Select the specific Worksheet
  If Range("e5").Value = "=yes" Then 'Measure value and if its a yes then it continues to clear old data
    If Range("a9").Value > 0 Then 'Checks to see if the area has already been cleared, if it has then it skips it
       Range("PI_DataClear").Select 'Named Range
         Selection.Clear 'Clears the named Range
    End If 'ends previous If then statement
  End If 'end first If Then statement
 If Range("a9").Value  0 Then 
   lastrow = Cells(Rows.Count, 1).End(xlUp).Row 'Next 6 line of code Performs calculations for pivot table
     Range("c9:c" & lastrow).Formula = "=IF(B9="""",A9,B9)"
     Range("g9:g" & lastrow).Formula = "=MONTH(F9)"
     Range("j9:j" & lastrow).Formula = "=IFERROR(ROUND(VLOOKUP($E9,Rate_Table,6,FALSE),2),"""")"
     Range("k9:k" & lastrow).Formula = "=IFERROR(ROUND(VLOOKUP($E9,Rate_Table,9,FALSE),2),"""")"
     Range("l9:l" & lastrow).Formula = "=IFERROR(ROUND(IF(G9=1,J9*I9,""""),2),"""")"
     Range("m9:m" & lastrow).Formula = "=IFERROR(ROUND(IF(G91,K9*I9,""""),2),"""")"

End With 'end selection of worksheet
'THE ERROR IS: "Compile Error: End With without With"

'Next 5 lines refershes all pivot tables in Workbook
    For Each wsheet In ActiveWorkbook.Worksheets 'Refreshes any pivot tables in the workbook
     For Each pTable In wsheet.PivotTables
     Next pTable
    Next wsheet

With Sheets("Emp Cost by Project").Select 'Select the specific Worksheet
Dim lastcol As Long
  Range("d:bb").EntireColumn.Hidden = False 'unhieds the columns
  ColAddress = Range("b1").Value 'Range b1 finds the last column of data in row2
  lastcol = Range("a1").Value    'count of columns in row 2
    Range("b1").Formula = "=LEFT(ADDRESS(2,(COUNTA(5:5)+5),4),LEN(ADDRESS(2,(COUNTA(5:5)+5),4))-1)"
    Range("a1").Formula = "=COUNTA(2:2)+4"
    Range("e1").Formula = "=""TOTAL"""
    Range("e2").Formula = "=""MONTH"""
    Range("f1:" & ColAddress & "1").Formula = "=OFFSET(F2,IF($E$6"""",COUNTA($D:$D)/2+COUNTA($E:$E),COUNTA($D:$D)+2),0,1,1)"
    Range("f2:" & ColAddress & "2").Formula = "=IF(F5="""",F4,IF(AND(F4=1,F5=""Jan
  ChkRow = 2 'Next line of codes hides the appropriate columns if in row 2:2 value = "hide" and the formula for that is
  BeginCOL = 6
  EndCOL = lastcol
    For ColCnt = BeginCOL To EndCOL 'start of hiding columns
      If Cells(ChkRow, ColCnt).Value = "Hide" Then
          Cells(ChkRow, ColCnt).EntireColumn.Hidden = True
      End If 'end of hiding columns
    Next ColCnt 'next column, start column is #6 which = F
End With

End If 

Application.ScreenUpdating = True 'RESTARTS SCREEN REFRESHING
Application.StatusBar = "If you elected to erase data, paste the new data in cell A9.  Otherwise your report is complete."
MsgBox Format(Timer - StartTime, "00.00") & " seconds" & "        FINISHED!"

End Sub

I have this whole worksheet setup, and anytime a user copies a sheet (move doesn't matter), i want to know, so i can perform some actions on the new sheet before the user can do anything

anyway, i have some code already in place so users can't delete certain sheets, so i figured i'd follow the same kind of idea, its basically using the commandbar and commandbarcontrol

Below i have the anti deleting of sheets, and under all the IF statements, is where the intercepting of copy is, but instead of intercepting copy, whenever i select a new sheet, the msgbox comes up

anyway know whats going on?

Private Sub Worksheet_Activate()
    Dim CB As CommandBar
    Dim Ctrl As CommandBarControl
    For Each CB In Application.CommandBars
        Set Ctrl = CB.FindControl(ID:=847, recursive:=True)
        If Not Ctrl Is Nothing Then
            If ActiveSheet.Cells(3, 5) = "2 OF 2" Then
                Ctrl.OnAction = "PreventDelete"
                Ctrl.State = msoButtonUp
            ElseIf ActiveSheet.Cells(3, 5) = "2 OF 3" Then
                Ctrl.OnAction = "PreventDelete"
                Ctrl.State = msoButtonUp
            ElseIf ActiveSheet.Cells(3, 5) = "3 OF 3" Then
                Ctrl.OnAction = "PreventDelete"
                Ctrl.State = msoButtonUp
            ElseIf ActiveSheet.Cells(3, 5) = "1 OF 2" Then
                Ctrl.OnAction = "PreventDelete2"
                Ctrl.State = msoButtonUp
            ElseIf ActiveSheet.Cells(3, 5) = "1 OF 3" Then
                Ctrl.OnAction = "PreventDelete3"
                Ctrl.State = msoButtonUp
            End If
        End If
        Set Ctrl = CB.FindControl(ID:=848, recursive:=False)
        If Not Ctrl Is Nothing Then
            MsgBox ("COPY INTERCEPTED")
        End If
End Sub

Hi Highly Esteemed,

I have an Excel workbook with two Columns A and B. I also have another column H which I want to populate depending on which keywords were found in A or B.

A - contains the subject of a message.
B - contains the message body itself (mean 1000 - 1200 characters).

What I want to do is of this nature:

Do Until end of used range
Activate the Cell I want to populate
Use instr() function to search cell A2 (increases with loop)

If keyword found (eg. downloading) in A2 then H2 = internet

If not found
Make the search string column B (for the same record)
Repeat the search for this column (same record)

If keyword found, then populate H2
else put "undefined" in H2
end if
end if

Now my VBA implementation works but is not very accurate - also the presence of too many if then...if then.... makes it inaccurate - I was wondering if anyone could help me code select case statements using instr() or any other suggestions.

Here is a section of my code:

Private Sub cmdReqClass_Click()
'Sub RequestClass()
Dim SearchString, SearchChar, MyPos

'character strings containing root words to be searched.

Searchinternet = "INTERN"
Searchpassword = "PURC"
SearchCharPrint = "PRINT"

'There are about 25 search strings in total
Do Until Selection.Offset(0, -7).Value = ""
SearchString = (UCase(Selection.Offset(0, -7).Value))

' String to search in.
' A textual comparison starting at position 1

If (InStr(1, SearchString, Searchinternet, 1) > 0) Then
ActiveCell.Value = "Internet Related"

ElseIf ((InStr(1, SearchString, SearchCharPrint , 1) > 0) ActiveCell.Value = "Printing"

ActiveCell.Value = "Undefined"
'SearchString = (UCase(Selection.Offset(0, -13).Value)))
Select Case InStr(1, UCase(Selection.Offset(0, -6).Value), SEARCHINTERNET, 1)

Case Is > 0
ActiveCell.Value = "Internet Related"

Case Is < 0
InStr(1, UCase(Selection.Offset(0, -6).Value), SearchPass, 1)

Case Else
ActiveCell.Value = "Undefined"
End Select

End If

Selection.Offset(1, 0).Select
End Sub

I have problem that Im sure would be easy to solve.

I have two listboxes together, where listbox1 contains my list of country destinations, and the clients add countries to listbox2 by selecting countries in listbox1 and clicking on "Add".

The counties that the clients select are then copied to a worksheet range and I want to ensure that when the clients return to the form that their selections are returned to listbox2 (so they dont have to reselect them).

The only problem is, of course, is if that range is still blank, it will copy the blanks to the listbox.

Therefore I need an If statement which will only copy the non-blank entries to the listbox, and exclude the blanks. I know that this is a really simple question, but I would greatly appreciate someone's help.

The code which copies the cell entries back to listbox2 is:

Sub FillInListbox2()

Dim cell As Range
Dim Rng As Range

Workbooks("Insurance Questionnaire Answers.xls").Activate

With Sheets("Travel")
Set Rng = .Range("a2", .Range("a2").End(xlDown))
End With

For Each cell In Rng.Cells
Me.ListBox2.AddItem cell.Value
Next cell

End Sub

I just need help to add the if cells are blank, then listbox2 is empty.

Many Thanks

i am using this code

Sub filter()

    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer, d As Integer
    Dim Swap1, Swap2, Item
'   The items are in h17:h1200
    Set AllCells = Sheets("ScoreCard").Range("h17:h1200")
'   The next statement ignores the error caused
'   by attempting to add a duplicate key to the collection.
'   The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
'       Note: the 2nd argument (key) for the Add method must be a string
    Next Cell

'   Resume normal error handling
    On Error GoTo 0

'   Sort the collection (optional)
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i
'   Add the sorted, non-duplicated items to a ListBox
    For Each Item In NoDupes
   UserForm1.ListBox1.AddItem Item
    Next Item

'   Show the UserForm
End Sub
however I need it to go into sheet(scorecard).range(A1) and down
i don't need the userform

    For Each Item In NoDupes
   sheet(scorecard).range(A1).AddItem Item
    Next Item
so somthing like that however i need it to go a1 then next one a2 so on