Free Microsoft Excel 2013 Quick Reference

Help with activation code Results

I have created a Group Box in Excel with 4 Option Buttons in the group. I have also created a Command Button which currently, when clicked, changes to a worksheet I specified. I am trying to have the Comand Button, when clicked, look at the selected Option Buttons in the Group Box and change to the worksheet specified by the selected Option Button. I have tried an IF..THEN statement with no success. I have posted the code below that I have tried. I appreciate any help someone could give me.


	VB:
	
 CommandButton1_Click() 
    If AM40 = 1 Then 
        Sheets("Billboards(1)").Select 
         'ElseIf AM40 = 2 Then
         '   Sheets("Live Events Feedback(1)").Select
    End If 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi

I need help with this error in my code, its the final part of the jigsaw for me to complete my project.

I am trying to find a variable that the user types in my spreadsheet and delete columns from several worksheets. I'm really close but keep getting the above error.

I would be very greatful if someone could assist me. As a forewarning, I'm aware that the code is very messy, but im new and having to learn on the fly in a very short period of time, and without help from people on forums like these, i'd be out of a job!

Here is the code.


	VB:
	
 
 
Sub DeleteEmp() 
     
    Dim RemoveEmp As String 
     
     
     ''' CURRENTLY DOES NOT WORK FOR SOME UNKNOWN STUPID REASON
     
     
    MsgBox "Warning.  This process will result in the permanent removal of an employees datails" 
     
    FinalWarning = MsgBox("Should I continue?", vbYesNo Or vbDefaultButton2, "Confirmation") 
     
    If FinalWarning = vbNo Then 
         
        Goto Chief 
         
    ElseIf FinalWarning = vbYes Then 
         
        Goto FinalDel 
         
         
        Chief: MsgBox "Action Cancelled." 
        Goto Chiefness 
         
FinalDel: 
         
        Do While RemoveEmp = "" 
            RemoveEmp = InputBox("Enter the name of the employee to remove", "Deletion Detected") 
            If RemoveEmp = "" Then Exit Sub 
        Loop 
         
        On Error Goto LevelOne 
         
        Sheets("Data Table - Turbines - Lincoln").Select 
        Cells.Find(What:=RemoveEmp, After:=Range("A4"), LookIn:=xlFormulas, LookAt _ 
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
        False, SearchFormat:=False).Activate 
         
        StartCell = ActiveCell.Offset(-3, 0).Address 
        EndCell = ActiveCell.Offset(250, 0).Address 
        Range(StartCell, EndCell).Select 
        Selection.Delete Shift:=xlToLeft 
         
LevelOne: 
         
        On Error Goto LevelTwo 
         
        [I][U][I]    Sheets("Data Table - Turbines - ABZ").Select 
        Cells.Find(What:=RemoveEmp, After:=Range("A4"), LookIn:=xlFormulas, LookAt _ 
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
        False, SearchFormat:=False).Activate[/I][/U][/I] 
         
         ''' Above is where the error is when it bugs out
         
        StartCell = ActiveCell.Offset(-3, 0).Address 
        EndCell = ActiveCell.Offset(250, 0).Address 
        Range(StartCell, EndCell).Select 
        Selection.Delete Shift:=xlToLeft 
         
LevelTwo: 
         
        On Error Goto LevelThree 
         
        Sheets("Data - Turbines - Bracknel").Select 
        Cells.Find(What:=RemoveEmp, After:=Range("A4"), LookIn:=xlFormulas, LookAt _ 
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
        False, SearchFormat:=False).Activate 
         
        StartCell = ActiveCell.Offset(-3, 0).Address 
        EndCell = ActiveCell.Offset(250, 0).Address 
        Range(StartCell, EndCell).Select 
        Selection.Delete Shift:=xlToLeft 
         
LevelThree: 
         
        On Error Goto LevelFour 
         
        Sheets("Data - Turbines - UK Stdby").Select 
        Cells.Find(What:=RemoveEmp, After:=Range("A4"), LookIn:=xlFormulas, LookAt _ 
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
        False, SearchFormat:=False).Activate 
         
        StartCell = ActiveCell.Offset(-3, 0).Address 
        EndCell = ActiveCell.Offset(250, 0).Address 
        Range(StartCell, EndCell).Select 
        Selection.Delete Shift:=xlToLeft 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Thanks again,

Sam

I need some help with the below code.

How do I get my worksheet (ServicePlan) to update column A (plan number) after deleting a the row from a userform. When I delete the row the plan numbers do not update.

Example: I delete plan #1 from the worksheet. The plan number #2 should now be amended to read plan #1 and the plan number for record #3 should now be amended to read Plan #2, however the plan numbers #2 and #3 remain the same.

Any help would be greatly appreciated.

Plan # Rv# Name: Dept: Rep:
1 1.1 mike Environmental Cathy S.
2 2.1 Tom Casualty Rich A.
3 1.5 Michelle Special Programs Diane

Here is the code I used for the delete plan # button. Thank you


	VB:
	
 
Private Sub CommandButton15_Click() 
     
    If MsgBox("Are you sure you wish to delete this record?", vbYesNo, "Confirm Deletion") = vbYes Then 
         
        sheet1.Activate 
         
        Dim strFind 
        Dim Nullstring 
        Dim rSearch As Range 'range to search
        Set rSearch = sheet1.Range("A2:A1000") 
        Dim c 
        Dim r As Long 
         
         
        strFind = UserForm1.plannum.Value 
        If strFind = Nullstring Then Goto error1 
         
        With rSearch 
            Set c = .Find(strFind, LookIn:=xlValues, MatchCase:=True) 
            If Not c Is Nothing Then 'found it
                 
                c.EntireRow.Select 
                c.EntireRow.Delete 
                Range("A2").Select 
                 
                 
            End If 
        End With 
         
         
        With Me 
             
            ClearData 
        End With 
         
        MsgBox "Record Sucessfully deleted", vbOKOnly 
         
    Else 
    End If 
     
error1: 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi

within a large section of code I am trying to count the number of columns within a range of data. The start point I am basing on a 'the cell after the first empty cell in a row' however the code produces a Runtime error 1004: Method range of object -global failed. The snippet of code is...


	VB:
	
rangelimit2 = Range("Cells(1, rangelimit + 2)").End(xlToRight).Column 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
If however I hard reference it as below the code works


	VB:
	
rangelimit2 = Range("i1").End(xlToRight).Column 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
However I would prefer not to do this to make make the macro more useable elsewhere.

Any help much appreciated.

Cheers
Sam

The complete code is...


	VB:
	
 charts2() 
     
    Dim rngLabels As Range 
    Dim rngData As Range 
    Dim lngIndex As Long 
    Dim sngLeft As Single 
    Dim sngTop As Single 
     
    Dim rangelimit As Integer 
    Dim rangeuse As Integer 
     
    If ActiveSheet.UsedRange.Count < 2 Then 
         'MsgBox 1
    Else 
        rangelimit = Range("A1").End(xlToRight).Column 
        rangeuse = rangelimit - 1 
    End If 
     
    sngLeft = 100 
    sngTop = 75 
     
     
    Set rngLabels = Range("a1", Range("A1").End(xlDown)) 
    For lngIndex = 1 To rangeuse 
        Set rngData = Union(rngLabels, Range(Cells(1, lngIndex + 1), Cells(1, lngIndex + 1).End(xlDown))) 
        With ActiveSheet.ChartObjects.Add(Left:=sngLeft, Width:=327, Top:=sngTop, Height:=229) 
            .Chart.SetSourceData Source:=rngData 
            .Chart.ApplyCustomType ChartType:=xlUserDefined, TypeName:="geoperformance" 
        End With 
        sngLeft = sngLeft + 100 
        sngTop = sngTop + 100 
    Next 
     
     
     
    Dim rngLabels2 As Range 
    Dim rngData2 As Range 
    Dim lngIndex2 As Long 
    Dim sngLeft2 As Single 
    Dim sngTop2 As Single 
     
    Dim rangelimit2 As Integer 
    Dim rangeuse2 As Integer 
     
    ActiveSheet.Activate 
     
    If ActiveSheet.UsedRange.Count < 2 Then 
         'MsgBox 1
    Else 
        rangelimit2 = Range("Cells(1, rangelimit + 2)").End(xlToRight).Column 
        rangeuse2 = (rangelimit2 - 1) 
    End If 
     
     
     
    sngLeft2 = 500 
    sngTop2 = 75 
    Set rngLabels2 = Range("i1", Range("i1").End(xlDown)) 
    For lngIndex2 = (rangelimit + 2) To rangeuse2 
        Set rngData2 = Union(rngLabels2, Range(Cells(1, lngIndex2 + 1), Cells(1, lngIndex2 + 1).End(xlDown))) 
        With ActiveSheet.ChartObjects.Add(Left:=sngLeft2, Width:=327, Top:=sngTop2, Height:=229) 
            .Chart.SetSourceData Source:=rngData2 
            .Chart.ApplyCustomType ChartType:=xlUserDefined, TypeName:="geoperformance" 
        End With 
        sngLeft2 = sngLeft2 + 100 
        sngTop2 = sngTop2 + 100 
    Next 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi,

I think various people have tried helping me with this problem before but I never really understood how to do it. I need to learn now as I have had enough with proceedure too large errors all the time!

Basically, I have a userform and on it is a combo box with the weeks in each month in it. A user has to select a week to enter figures for and then enter the figures into text boxes on the same form. When the click submit (command button), based on what week they've already selected, my code will put the figures into the spreadsheet in the appropriate place.

At the moment my code looks something like this


	VB:
	
 december1() 
     
    Worksheets("Dec").Activate 
     
    If Figures1.TextBox1.Value >= "1" Then Range("c16") = Figures1.TextBox1.Value 
    If Figures1.TextBox2.Value >= "1" Then Range("c17") = Val(Figures1.TextBox2.Value) / 100# 
    If Figures1.TextBox3.Value >= "1" Then Range("c18") = Figures1.TextBox3.Value 
    If Figures1.TextBox4.Value >= "1" Then Range("c22") = Figures1.TextBox4.Value 
    If Figures1.TextBox5.Value >= "1" Then Range("c23") = Figures1.TextBox5.Value 
    If Figures1.TextBox6.Value >= "1" Then Range("c28") = Figures1.TextBox6.Value 
    If Figures1.TextBox7.Value >= "1" Then Range("c29") = Val(Figures1.TextBox7.Value) / 100# 
    If Figures1.TextBox8.Value >= "1" Then Range("c30") = Figures1.TextBox8.Value 
    If Figures1.TextBox9.Value >= "1" Then Range("c34") = Figures1.TextBox9.Value 
    If Figures1.TextBox10.Value >= "1" Then Range("c35") = Figures1.TextBox10.Value 
    If Figures1.TextBox14.Value >= "1" Then Range("c46") = Val(Figures1.TextBox14.Value) / 100# 
    If Figures1.TextBox15.Value >= "1" Then Range("c47") = Val(Figures1.TextBox15.Value) / 100# 
    If Figures1.TextBox11.Value >= "1" Then Range("c40") = Figures1.TextBox11.Value 
    If Figures1.TextBox12.Value >= "1" Then Range("c41") = Figures1.TextBox12.Value 
    If Figures1.TextBox13.Value >= "1" Then Range("c42") = Figures1.TextBox13.Value 
    If Figures1.TextBox16.Value >= "1" Then Range("c51") = Val(Figures1.TextBox16.Value) / 100# 
    If Figures1.TextBox17.Value >= "1" Then Range("c52") = Val(Figures1.TextBox17.Value) / 100# 
    If Figures1.TextBox18.Value >= "1" Then Range("c53") = Figures1.TextBox18.Value 
    If Figures1.TextBox19.Value >= "1" Then Range("c54") = Figures1.TextBox19.Value 
    If Figures1.TextBox20.Value >= "1" Then Range("c55") = Figures1.TextBox20.Value 
     
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
That is just for one week!

Is there a way that I could simply use one part of code to do the whole year? The rows that the figures are going into are not sequential though!

I am a relative newcomer to VBA so don't really understand it's full potential yet!

Thanks

Paul

I was disabling certain functions on workbook activate, and I noticed i was unable to right click any cell. I used the code below, but that only let me right click on a cell to get options. I still cannot right click on a column or row heading with options coming up
please help!

Hello, I am new in coding with VBA... i'm trying to do a transfer of data form diferent sheets to another sheet and I have code this


	VB:
	
 dercell_appli - première_ligne + 1 
    For j = 1 To dercell_biblio 
        Workbooks(filename_biblio).Activate 
        If tab_appli(1, i) = Cells(j, 15) And Cells(j, 19)  "Not defined" And Cells(j, 19)  "" And Cells(j, 19)  "-" Then 
            Workbooks(filename_appli).Activate 
            If Cells(première_ligne - 1 + i, colonne_valeur)  "-" Then 
                Cells(première_ligne - 1 + i, colonne_valeur).Copy 
                ws.Activate 
                Cells(j, 5).PasteSpecial Paste:=xlPasteValues 'problème lié à la présence du caractère "$"->transformation en
euros...Il faut copier la valeur
                presence = True 
                 
                If Cells(j, 34) = "" And Cells(j, 33)  "Appli" And Cells(j, 33)  "MAP" And Cells(j, 15)  "refmesag" Then 
                    presence = False 
                    l = l + 1 
                    Redim Preserve absence_lab(1 To l) 
                    absence_lab(l) = tab_appli(1, i) 
                End If 
                 
            End If 
        ElseIf tab_appli(1, i) = Cells(j, 15) And (Cells(j, 19) = "Not defined" Or Cells(j, 19) = "" Or Cells(j, 19) = "-")
Then 
            dim_erreur_équivalent_label = dim_erreur_équivalent_label + 1 
            Redim Preserve tab_erreur_équivalent_label(1 To dim_erreur_équivalent_label) 
            tab_erreur_équivalent_label(dim_erreur_équivalent_label) = Cells(j, 15) 
             
        End If 
    Next j 
Next i 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
The problem is that it takes a lot of time in doing this procedure so I would like to know if someone can help me or give me tips to improve it and make it faster.

hello VB experts,

I have weekly meeting on inventory status with internal customers, with more than 20 columns & rows in Excel spreadsheet. Sometimes it was difficult to focus their attention as people having questions on different Part Number jump from one row to another. I am looking for a code or AddIn where the active row (the row where my cursor's position is at) will be highlighted each time I move the cursor. I have tried the popular "HiLite.xla" and the recent "RowLiner.xla" but not what I want. Greatly appreciate if anyone can help me on this.

Thanks very much in advance.

Hey everyone!

I am having a problem with this code returning and Application Defined or Object defined error.
It is not highlighting the error.

Here is the code:


	VB:
	
 
Sub test() 
     
    Range("Clear1").Clear 
    Range("val1").Clear 
     
    Sheets("Sheet1").Activate 
     
     
    Dim str As String 
    Dim rFound As Range 
    Dim sAddr As String 
     
     
    str = Range("Criteria1") 
     
     'search For items
    Set rFound = Columns("B").Find(what:=str, LookIn:=xlValues, _ 
    LookAt:=xlPart) 
    If Not rFound Is Nothing Then 
        sAddr = rFound.Address 
        Do 
            With rFound 
                 
                 'Determine Next Empty Row
                NextRow = Application.WorksheetFunction.CountA(Range("H:H")) + 1 
                Cells(NextRow, 8).Value = .Offset(0, -1).Value 
                Cells(NextRow, 9).Value = .Offset(0, 1).Value 
                Cells(NextRow, 10).Value = .Offset(0, 2).Value 
                Cells(NextRow, 14) = Cells(NextRow, 8) & " " & _ 
                Cells(NextRow, 9) & " " & Cells(NextRow, 10) 
                 
                 
            End With 
             
            Set rFound = Columns("B").FindNext(rFound) 
        Loop While rFound.Address  sAddr 
    End If 
     
    Dim AllCells As Range, Cell As Range 
    Dim NoDupes As New Collection 
     
     
    On Error Resume Next 
    For Each Cell In Range("val1") 
        NoDupes.Add Cell.Value, CStr(Cell.Value) 
    Next Cell 
    On Error Goto 0 
     
    Dim Holder 
    Holder = "" 
     
     
    For i = 1 To NoDupes.Count 
        Holder = Holder & NoDupes(i) & "," 
    Next i 
    Holder = Left(Holder, Len(Holder) - 1) 
     
     
     
    Range("A14").Activate 
     
    With ActiveCell 
        ActiveCell.ClearComments 
        .AddComment 
        .Comment.Visible = False 
        .Comment.Text Text:="Text " & Holder 
    End With 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
I believe the problem to be in this part:


	VB:
	
 
Dim str As String 
Dim rFound As Range 
Dim sAddr As String 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
But cannot be sure.

Your help is appreciated!
nu

Hello,

I am stuck on a simple find code.

Basically, I want to enter a value in a textbox, search for it in an worksheet, and populate other textboxes with adjacent values if the value is found.

Anyway, the problem is that if the value is not found, I get a debug error.

Can someone help me with this code?


	VB:
	
 test1 
test1 = TextBox1.Value 
Worksheets("data1").Activate 
Find_Range(test1, Cells, xlFormulas, xlWhole).Select 
TextBox2 = ActiveCell.Value 
TextBox3 = ActiveCell.Offset(0, 1).Value 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
I'm sure there's far better code to do what I need, but I tried to keep it simple. With the above code, it only works if the value is found. If it's not, I get an error.

So how do I make it so that if the value is not found, the value of the textbox2 is "Not Found" or something...

Thanks for the help!

I am using PrimoPDF, as suggested elsewhere in the forum, to attach a PDF to an E:Mail and send it automatically, it works a treat ... however, I do have to manually intervene to click on the OK button & then again to click on YES when the filename is duplicate.

I would like to automate these actions and am looking for a way to do it. It looked like the SendKeys command was perfect, but I'm not 100% sure how to do it.

The PrimoPDF window is open, named as "PrimoPDF", but is not my active window, so I have put ...


	VB:
	
PrimoPDF.SendKeys "{Enter}" 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
... into the program but I am getting the error message "Run Time Error '424': Object required".

Is this something to do with my code ? I am guessing that the program isn't recognising that PrimoPDF is an open & inactive window, so am I missing a prefix here or is it something more serious, like having to add a new Component or Additional Controls ?

Any help appreciated, cheers ...

Hello everyone, I've been working a macro that seems pretty simple, but has been giving me loads of trouble. I have about 20 worksheets in a Workbook, which all have a similar template (i.e. the data I'm interested in starts on row 14), but have different amounts (rows) of data in them. I want a macro that sorts all the data in ascending/descending order according to column Q. The problem that I am running into is not that the macro only works for the sheet that is active when I run the macro as opposed to every single sheet in the workbook. Please help if you can...here is the code:

	VB:
	
 Sorter() 
     
    Dim xlSort As XlSortOrder 
    Dim WkSht As Worksheet 
     
    If Range("Q14") > Range("Q15") Then 
        xlSort = xlAscending 
    Else 
        xlSort = xlDescending 
    End If 
     
     
     
    For Each WkSht In ActiveWorkbook.Worksheets 
         
         
         ' Dynamically Define the range called Range1 on the page
        ThisWorkbook.Names.Add Name:="Range1", _ 
        RefersTo:="=OFFSET($B$14,0,0,COUNTA(C:C)-1,26)", Visible:=False 
         
         
         ' Sort the range
        With Range("Range1") 
            .Sort Key1:=Range("Q14"), Order1:=xlSort, Header:=xlNo, _ 
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
            DataOption1:=xlSortNormal 
        End With 
         
        ThisWorkbook.Names("Range1").Delete 
         
    Next WkSht 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hello

Is there a way to select multiple worksheets in an Array using the worksheets code name instead of the worksheet Tab names.

This is my code which works just fine, but the Tab names will change every month and I don’t want to have to edit the code every month.


	VB:
	
Sheets(Array("WEnd 5-5", "WEnd 5-12", "WEnd 5-19", "WEnd 5-26", "WEnd 6-2")). _ 
Select 
Sheets("WEnd 5-5").Activate 
Range("H2:AQ43").Select 
Selection.ClearContents 
Sheets("WEnd 5-5").Select 
Range("C2").Select 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
I tried modifying the above script to use Worksheet code names but I can not get the below script to work for me. I have tried different variants with no luck. Could someone Please help me.

	VB:
	
Sheet(Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6")). _ 
Select 
Sheet2.Activate 
Range("H2:AQ43").Select 
Selection.ClearContents 
Sheet2.Select 
Range("C2").Select 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Greetings,

I have a cell which uses part of the name of the workbook. This name is updated everytime I activate the sheet with this code (in the worksheet code section):

	VB:
	
 Worksheet_Activate() 
    Range("Workbook_Name").Value = "" 
    If Mid(ActiveWorkbook.Name, 34, 1) > "" Then 
        Range("Workbook_Name").Value = Mid(ActiveWorkbook.Name, 23, 12) 
    End If 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Workbook_Name is a named range for the cell in which I want the truncated portion of the file name to appear.

Is there anyway to trigger an update using vba with the SaveAs event?

Any help is greatly appreciated.

-Minitman

I have a 'master' worksheet, which contains a list of active workbooks. Each row on the master contains several data elements from each of the active workbooks:

File#, Date, Status, Customer, Etc.

This is accomplished by copying a row of data in the active workbook and pasting as a link on the master.

When an active workbook data element is changed (date, or status, for example), the link on the master changes as well. Then the active workbook is closed until needed again.

The linked data on the master allows for an overview of active files, and for sorting based on certain criteria, such as the next date to action the file.

What I now wish to do is eliminate the process of copying & pasting; this would be done, in theory, by putting a formula in each cell of the master that references a variable: the file number, located in column A.

Thus, where the pasted link formula reads:
='C:Active Files[4545.xls]Home'!$O$1
The desired theoretical formula would read:
='"'C:Active Files["&$A25&".xls]Home'!$O$1"

However, as you would already know, Excel does not permit a variable file name in this type of formula.

The first solution is the INDIRECT function, but because the workbooks are closed after the relevant fields are updated, and the master is frequently re-calced, this invalidates the goal of visible summary data with less work.

The next solution would be the "morefunc" add-in and its' INDIRECT.EXT function; this actually is a perfect solution, but for one small problem: it is unstable, and causes Excel to crash. Without blaming Laurent for his work, it does seem to be a widespread problem with the add-in that is not fixable by the lay-user. Maybe he could just give up the code for this particular function.

I've kicked around a couple of the VBA codes offered up by some of the pro's, but repeatedly run in to problems with making them fit my particular need. The reason for that is that I am learning VBA but am still a long way from understanding it.

To summarize, I am looking for a formula or code that will allow me to link data from external workbooks with a variable file name. This would permit me to copy the formula down the rows, eliminating the need to copy/paste the links one at a time. It does not have to access the data from the workbook when it is closed, as the change will always happen when it is open, but it cannot lose the data when the workbook is closed (as INDIRECT does.)

I look forward to getting some feedback on this, and will gladly provide whatever additional information may be needed to help resolve this (minor) dilemna.

TIA
Bob

PS - Very generic examples were attempted to be attached, but the master sample failed to upload repeatedly, so I regret that I cannot give samples to look at.

Why does my Excel hang on this code:

	VB:
	
 "" 
     
    TempWaarde1 = Cells.Value(Posi, 1) 
    TempWaarde2 = Cells.Value(Posi - 1, 1) 
     
    If TempWaarde1  TempWaarde2 Then 
        ListBox1.AddItem TempWaarde1 
    End If 
     
    Posi = Posi + 1 
Wend 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
What I'm trying to achief is to fill a listbox with all values in the first column of the active sheet, but avoiding double entry's if they're on the row after the 1st one. When I execute this in my Userform_Initialize, Excel hangs like the while-wend loop is never finishing, while i'm sure there is no more data in the 1st column after 200 rows or so. Any help would be really appreciated.

Hi

I've built a macro to run a loop that opens excel files, prints certain sheets and closes them. I have the macro working - to some degree. here is my code (this is excel):

	VB:
	
 RMPProducer() 
     
    OldPath = "S:RMBS_Performance_AnalyticsAnalysis1 Staging Folder For Monthly Model Templates2007200704VVDeals" 
    Dim t As Workbook 
    Dim s As String 
    Dim a As Window 
     
    With Application.FileSearch 
        .NewSearch 
        .LookIn = OldPath 
        .SearchSubFolders = False 
        .Filename = "*.xls" 
        .MatchTextExactly = True 
        If .Execute() > 0 Then 
            For i = 1 To .FoundFiles.Count 
                s = .FoundFiles(i) 
                Workbooks.Open (s) 
                Set t = Workbooks(i) 
                t.Activate 
                ActiveWindow.ActivateNext 
                ActiveWorkbook.Sheets("Summary").Select 
                ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 
                ActiveWorkbook.Sheets("Collateral Graphs").Select 
                ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 
                ActiveWorkbook.Sheets("CLASS CE GRAPH").Select 
                ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 
                ActiveWorkbook.Sheets("XS AND OC TABLE").Select 
                ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 
                 
            Next i 
        Else 
            MsgBox "There were no files found." 
        End If 
    End With 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
I have 2 problems. First problem is that I am trying to add a function to make the window close once its finished printing. This actually works - but it limits my loop iterations from i = 1 to 2 (so it only runs 2 times and I'm not exactly sure why). If I don't include the statement - this can run for up to 7 - 8 times (these are very large files) then excel runs out of memory. Unfortunately, i can't set the loop to run from i = anything other than one.

So What I would prefer is to be able to make the "ActiveWindow.close" command work - because this way I can run the entire loop. But I'm not sure how to. I tried window referencing, I tried adding a new active Window so when the file opens, its opening in the active window already, but nothing works.

Preferably, I need to be able to reference both windows, as my next macro will involve referencing 2 windows (one static - always open) and the other the loop above.

Anyone have any ideas? All help is appreciated.

I have created a macro which unhides a sheet (Email) in one book and takes that info to #1 create an email and #2 open a new file and paste data into it.
Problem is, I want to go back to the first book and hide the sheet (Email) since other users will be using the macro. I keep getting a run time error 9 'Subscript out of range'.
I have my code below. I have commented out the last few lines that used to work before I had to open a new book first.

Please help!

	VB:
	
 AcceptEmail() 
     
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim cell As Range 
    Dim filedoc As String 
    Dim intFreeRow 
     
    Sheets("Email").Visible = True 'make visible as we need values from sheet for emails below
     
     'cannot hit accept command with below target checked
    If Sheets("Comparison").OLEObjects("CheckBox3").Object.Value = True Then 
        MsgBox "You cannot accept a profile below target.", vbOKOnly, "Incorrect Data" 
        Range("R3").Select 
        Exit Sub 
    End If 
     
     'if concessions is checked
    If Sheets("Comparison").OLEObjects("CheckBox1").Object.Value = True Then 
        Sheets("Email").Select 
        Range("V1").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("V2").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("V3").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("V4").Select 
        ActiveCell.FormulaR1C1 = "Y" 
    End If 
     
     'if discounts is checked
    If Sheets("Comparison").OLEObjects("CheckBox2").Object.Value = True Then 
        Sheets("Email").Select 
        Range("W1").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("W2").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("W3").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("W4").Select 
        ActiveCell.FormulaR1C1 = "Y" 
    End If 
     
     
     
     'if other origins is checked
    If Sheets("Comparison").OLEObjects("CheckBox4").Object.Value = True Then 
        Sheets("Email").Select 
        Range("X1").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("X2").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("X3").Select 
        ActiveCell.FormulaR1C1 = "Y" 
        Range("X4").Select 
        ActiveCell.FormulaR1C1 = "Y" 
    End If 
     
     
    Sheets("Email").Select 
     
     'get name of company to use to save file
    Range("A3").Select 
    filedoc = "C:Tier Documents" & RTrim(ActiveCell.Value) & ".xls" 
     
    Range("A1").Select 
     
    Application.ScreenUpdating = False 
    Set OutApp = CreateObject("Outlook.Application") 
    OutApp.Session.Logon 
     
    Set OutMail = OutApp.CreateItem(0) 
     
    With OutMail 
        .To = ActiveCell.Value 
        .CC = ActiveCell.Offset(1, 0) 
        .Subject = ActiveCell.Offset(2, 0) 
         
        .Body = ActiveCell.Offset(3, 0) & vbCrLf & vbCrLf 
        .Body = .Body & ActiveCell.Offset(4, 0) & vbCrLf 
        .Body = .Body & ActiveCell.Offset(5, 0) & vbCrLf 
        .Body = .Body & ActiveCell.Offset(6, 0) & vbCrLf & vbCrLf 
        .Body = .Body & ActiveCell.Offset(7, 0) & vbCrLf 
        .Body = .Body & ActiveCell.Offset(8, 0) & vbCrLf 
        .Body = .Body & ActiveCell.Offset(9, 0) & vbCrLf 
        .Body = .Body & ActiveCell.Offset(10, 0) 
         
        .display 
         
         
    End With 
     
     'select range in email sheet to copy into tier document tracking
    Sheets("Email").Activate 
    Range("L1:Y1").Select 
    Selection.Copy 
    Workbooks.Open Filename:= _ 
    "C:TDocuments.xls" 
    Workbooks("TDocuments.xls").Activate 
     'Below i look for the first empty row to paste the values from Email sheet in
    intFreeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 
    Cells(intFreeRow, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
     
    ActiveWorkbook.Save 
    ActiveWorkbook.Close 
     
     'HERE IS WHERE I WANT TO REACTIVATE THE BOOK AND HIDE THE EMAIL SHEET
     
     'Workbooks(filedoc).Activate - THIS IS WHERE I GET THE RUN TIME ERROR
     '    Sheets("Email").Select
     '    ActiveWindow.SelectedSheets.Visible = False
     '    Sheets("Comparison").Select
     '    Range("AK5").Select
     '    Selection.AutoFilter Field:=16
     
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


I'm trying to take the value of a cell and use the value as a name for the row.
If cell a1 has value = June. I want to change the name of row 1 to June.
I'm not sure what I'm doing wrong with the following code.

Sub Name_a_row()
'
'
Dim TheName As String
Dim RowNum As Integer
TheName = ActiveCell.Value
RowNum = ActiveCell.Row
ActiveWorkbook.Names.Add Name:="TheName", RefersToR1C1:="=Data!R&RowNum"

End Sub

Thanks for the help.

Hello,

I'm trying to have change if the date on it is passed "now()". I am already using the 3 conditional formatting fields and need this one and another one.

Here are 2 problems I seem to be having.
First - the code below only works if I change the date on the cell. I want code to either work with Worksheet Active or any other way so the user does not have to redo the date’s everyday.
Second - a record might have conditional formatting already. Is it possible for the target cell in this code can show this color while the rest of the row shows the color of the conditional formatting?


	VB:
	
 Range) 
    Dim icolor As Integer 
     
    If Not Intersect(Target, Range("G1:G2000")) Is Nothing Then 
        Select Case Target 
        Case Is