Free Microsoft Excel 2013 Quick Reference

Infinite range Results

A few days ago, Tom Ogilvy provided a macro for me on
this newsgroup that enabled someone to search an entire
workbook in Excel 97/2000, not just the current sheet.
I'm posting a follow up question as a new thread as Tom
is probably not still checking the original thread.

The macro Tom supplied (pasted below) creates an infinite
loop if (I think) you give an empty string in response to
the input box. It just keeps putting up the message "Hit
key to continue" and you can't break out of it.

Would it be possible for anyone (or Tom if he's reading
this) to correct the macro so an infinite loop does not
occur, please?

Thanks
Steve Wylie

Sub FindAll()
Dim sh As Worksheet
Dim rng As Range
Dim sStr As String
sStr = InputBox("Enter search text")
If sStr = "" Then
MsgBox "You hit cancel"
End If
For Each sh In ActiveWorkbook.Worksheets
Set rng = sh.Cells.Find(What:=sStr, _
After:=sh.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
If Not rng Is Nothing Then
Application.Goto rng, True
MsgBox "Hit key to continue"
End If
Set rng = sh.Cells.FindNext(rng)
Loop Until rng.Address = firstAddress
End If
Next
End Sub

Hello,
On sheet 1 I use array formulas that have a set row range. Example
(A1:A1000). Sheet 1 requests date from sheet 2.
On sheet 2 there is data imported from another application that leaves page
header info multiple times, and I use a "cleanup" formula to delete the rows
that contain the unwanted page header info.
I have found that the row deletion on sheet 2 changes the ranges in the
formulas on sheet 1. Example, If the cleanup formula deletes 10 rows on sheet
2, the formula range on sheet 1 changes from A1:A1000 to A1:A990. Everytime I
run it, the range is reduced further. This is the cleanup formula:
Sub DeleteRowsRTH()
FindString = "*COMPANY*" 'adjust to company name
Set b = Range("A:H").Find(what:=FindString, lookat:=xlWhole)
While Not (b Is Nothing)
b.Resize(10).EntireRow.Delete
Set b = Range("A:H").Find(what:=FindString, lookat:=xlWhole)
Wend
End Sub

I don't beleive I can use infinite row designations (A:A) for an array
formula. I tried and get a #NUM error. Is there any way I can lock the
ranges on sheet 1 so they don't change?........or perhaps some other approach
to this problem?
thanks,
Robert

Hi guys,

I ve attached my sheet. I want columns A to look like G but the data im working is not limited from A1 to A170. It has to work until it wont find any value downside.

My code is based on the selection change and when a cell is selected, it checks to see if the cell is calculating an average. But what I want to do is to trace the precedents of the cell I just selected.

Private Sub
Worksheet_SelectionChange(ByVal Target As Range)
    'Is ActiveCell calculating average?
    If InStr(1, ActiveCell.Formula, "AVERAGE", vbTextCompare) Then
        ListPrecedents
    End If
End Sub
Sub ListPrecedents()

    Dim rStart As Range
    Dim rPrecCells As Range
    Dim cell As Range
    Dim sPrecList As String
    
    Set rStart = Sheet1.Range("F9")
    'In this case, F9 is acting a ActiveCell, I just haven't changed it for various reasons
    
    On Error Resume Next
    Set rPrecCells = rStart.precedents
    On Error GoTo 0
    
    If Not rPrecCells Is Nothing Then
        For Each cell In rStart.precedents.Areas
            sPrecList = sPrecList & cell.Address(0, 0) & ","
        Next cell
        
        sPrecList = Left(sPrecList, Len(sPrecList) - 1)
    Else
        sPrecList = "No Precedents Found"
    End If
    
    MsgBox sPrecList
End Sub

Problem is, after I select the cell, the function outputs by MsgBox but goes into infinite loop so clicking OK will bring up another MsgBox. If I change the event handler to something else, before right click or whatever, this does not occur. Any ideas?

I am attempting to create a formula for a project. The multipliers I use will be based off of # of units used. So lets say I have 500,000 units. The first 100,000 would be multiplied by 9.3, 100,000.01 - 250,000 would be multiplied by 9.5 and 250,000.01 - infinite be multiplied by 9.7. I know I can created different cells, but wanted to see if this could be done with one formula. I tried using sumif but that doesnt appear correct. Any help would be appreciated. Thank you.

Hey everyone,

I'm working on a spreadsheet that uses dropdowns (Yes/No) in certain cells that turn other cells gray or enter text into specific cells.

For most of the cells, I just want the color to change. This works without a problem:

If Range("P2").Value = "Yes" Then
    Range("Q2").Interior.Color = RGB(192, 192, 192)
End If
However, if I try to insert text into another cell, I get a long run-time error that says "Method 'Color' of object 'Interior' failed.

If Range("P2").Value = "Yes" Then
    Range("Q2").Value = "Example text for cell"
End If
When I stepped through the code in debug mode it worked fine with just the colors, i.e. it would get to End Sub and stop. However, as soon as it gets to the part where it should insert the text, it skips back to the top of the Private Sub and loops through infinitely.

Any suggestions are appreciated. Thanks!

Hello to all

What I have is a column of round numbers with an infinite range.

If any cell within that column is equal to "0", I want to replace this with the word "Closed".

But if the cell is greater than "0", I want to replace the value with the word "Open".

What code would achieve this?

Thank you

Hi everyone,

Firstly sorry for being probably rather naive with excel but I have a basic knowledge and have been asked to create a spreadsheet for work. Got the basics done but need to create some formulas so the colours change.

I basically need all the cells from A to F (need to go down infinitely) to start off red. Then when the cells from G to I are completed all the cells from A to I will turn orange then I have 5 more columns (J to N) that have yes and no data validation in them and when they are completed I want all the cells from A to N to automatically turn green. this is a continuous spreadsheet that will be used daily so the formula has to carry on downwards unlimited.

Sorry again for my lack of knowledge but when i learn something it stays in this head of mine so always happy to learn more.

If you have any questions just let me know.

Thanks in advance,

Jamie

I am getting an infinite loop when I run this code and today's date
isn't found. I'd like it to do nothing if it's not found. How would I
do that ?

For Each rCell In Selection
If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Activate

Next rCell

Ok, so here is my data:
	NO	NO
8	Inf.	6	8	4	1	3	8
What I want to achieve is to find the minimum value in the bottom row, however columns that have "YES" in the top row should be ignored when calculating the minimum, (so in the example above the minimum in the second row would be 3, as the 1 in the BLUE column is ignored).

In addition to this, some, all, or none of the bottom row could have the text "Inf." instead of a value. In my data this represents 'Infinite' so can effectively be ignored.

Finally, to highlight an issue I have had, if all of the bottom row are "Inf." then running MIN() against the bottom row will return 0, however in this situation that is obviously misleading.

Thanks all, I hope to learn something here

Okay I am going to have an infinite number of sheets that I will need to copy data from, the data on these sheets will be based off a formula from other information based in the sheet (these cells will be non-sequential) . I need to transfer these values to another sheet.

Say Cell B7 has a formula in it. How do I transfer the value and not the formula? So I don't recieve the "#VAL" in the output on my master sheet?

Thanks for the help.

~Darrel

I'm using:
Sub MakeSummaryTable()
    Dim ws As Worksheet
      
    Application.ScreenUpdating = False
    Sheets("Sheet1").Activate
     
    For Each ws In Worksheets
        If ws.Name <> "Sheet1" Then
            ws.Range("B5").Copy
            ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
            ws.Range("B6").Copy
            ActiveSheet.Paste Range("B65536").End(xlUp).Offset(1, 0)
            ws.Range("B7").Copy
            ActiveSheet.Paste Range("C65536").End(xlUp).Offset(1, 0)
            ws.Range("B8").Copy
            ActiveSheet.Paste Range("D65536").End(xlUp).Offset(1, 0)
            ws.Range("B11").Copy
            ActiveSheet.Paste Range("F65536").End(xlUp).Offset(1, 0)
        End If
    Next ws
    
    Application.ScreenUpdating = True
    
    
    
End Sub


Edit:
Nevermind...apparently Excel 2007 has a built in subtotal feature which does exactly what I was looking for...how about that...thanks anyways to anyone who looked at this.

Hello All, new here, and a big-time programming newbie, but I have some code and I think it semi-works, but it has an infinite loop (not good), and not 100% certain it is doing what I want it to do.

Here's the situation:

I have 2 columns, A & B, and many rows. There are header columns in Row 1 In column A are item #s, in column B are quantities. What I want the macro to do is check the value of column A and see if it matches the value below it, if it does, it needs to sum the value of column B with the value below it. If it does not, it needs to print the value of column B.

So in pseudo code:

If (Column A Row 2 = Column A Row 3)
{
Then (Sum(Column B Row 2 + Column B Row 3))

Else (Print(Column B Row 2))
}

Now here is my macro thus far:

Sub SumSame()

    Dim i As Integer, j As Integer
        
    'i = ActiveCell.Range
            
    For i = ActiveSheet.UsedRange.Rows.Count To 6 Step -1
       
    If ActiveSheet.Range("A" & i).Value <> "" Then
    'ActiveSheet.Range("A" & (i + 1)).Value Then
    
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-2]C[-1]:RC[-1])"
    
    End If
    
    i = i + 1
    
    Next i
    
End Sub
Thanks for any and all help, I truly appreciate it.

I have a range of data A2:E16 in which each row needs to be copied and pasted into another worksheet cell by cell. After this the worksheet needs to be printed, this needs to repeat for each row in the range. I recorded a macro for the action I want repeated, when I tried a For loop I entered an infinite loop of printing the same thing. So my loop didn't cycle row by row through the range and it never stopped. I'm using VB6.5 and excel 2007. This is a sample range of the entire data, it will take days to print these one by one without a macro. Your help will be greatly appreciated. Below is the macro I've been working with

' quickprint Macro
'
' Keyboard Shortcut: Ctrl+h
'
Dim i As Variant

Sub Cell_Loop()
For Each i In Worksheets("Modified").Range("A2:E16").Cells

Range("A2").Select
Selection.Copy
Sheets("Sign").Select
Range("D21:P31").Select
ActiveSheet.Paste
Range("W21:AI31").Select
ActiveSheet.Paste
Sheets("Modified").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sign").Select
Range("D2:P17").Select
ActiveSheet.Paste
Range("W2:AI17").Select
ActiveSheet.Paste
Sheets("Modified").Select
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sign").Select
Range("D18:P20").Select
ActiveSheet.Paste
Range("W18:AI20").Select
ActiveSheet.Paste
Sheets("Modified").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sign").Select
Range("E32:H36").Select
ActiveSheet.Paste
Range("X32:AA36").Select
ActiveSheet.Paste
Sheets("Modified").Select
Range("E2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sign").Select
Range("M32:P36").Select
ActiveSheet.Paste
Range("AF32:AI36").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Next i
End Sub

End Sub

hello all...

i'm trying to loop through a bunch of worksheets and copy certain cells and paste it in a master sheet.

Please take a look at my code below because it keeps copying the same thing over and over and is stuck in an infinite loop.

For Each ws In ActiveWorkbook.Worksheets
    
    If ws.Visible = True Then
        ws.Activate

        Set rFind = Cells.Find(What:="Critical Activities / Watch List Items / and Milestones for Next 3 Months",
After:=[A1], _
                                LookIn:=xlValues, _
                                lookat:=xlPart, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False, _
                                SearchFormat:=False)
        If Not rFind Is Nothing Then
        'if it's the first sheet, copy the column headers, if not skip the headers
            If ActiveSheet.name = "A1 Replace Citichecking" Then
                currentRow = rFind.Row + 1
            Else
                currentRow = rFind.Row + 2
            End If
            'copy all rows until empty line, insert date and name
            'Do While Not IsEmpty(Cells(currentRow, 2))
            Do While (Cells(currentRow, 2) <> "Issues/Risks Log")
                Select Case Cells(currentRow, 2)
                    Case Is = ""
                        currentRow = currentRow + 1
                    Case Is = "Major Milestones to Program End Date Beyond Current 3 Month Cycle (Maximum 10
Items)"
                        currentRow = currentRow + 1
                    Case Is = "26. Responsible Area / Owner"
                        currentRow = currentRow + 1
                    Case Else
                        Set rFindw = ActiveSheet.UsedRange.Find("Program Id", LookIn:=xlValues, lookat:=xlWhole)
                        currentRow = rFindw.Row + 1
                        strprogID = Range("K" & currentRow).Value
                        strcritical = "BCM"
                        strMileName = Range("C" & currentRow).Value
                        strMileStatus = Range("I" & currentRow).Value
                        strReason = Range("M" & currentRow).Value
                        strDescr = Range("D" & currentRow).Value
                        dtOrig = Range("G" & currentRow).Value
                        dtActual = Range("H" & currentRow).Value
                        strCommit = Range("L" & currentRow).Value
                        strMileCmmt = Range("N" & currentRow).Value
                        strRemCmmt = Range("O" & currentRow).Value
                        
                            If rFindw Is Nothing Then
                                MsgBox "Not Found"
                                Exit Sub
                            End If
                        dest.Range("A" & cursor).Value = strprogID
                        dest.Range("B" & cursor).Value = strcritical
                        dest.Range("C" & cursor).Value = strMileName
                        dest.Range("D" & cursor).Value = strMileStatus
                        dest.Range("E" & cursor).Value = strReason
                        dest.Range("F" & cursor).Value = strDescr
                        'dest.Range("F" & cursor).EntireColumn.WrapText = True
                        dest.Range("G" & cursor).Value = dtOrig
                        dest.Range("H" & cursor).Value = dtActual
                        dest.Range("I" & cursor).Value = strCommit
                        dest.Range("J" & cursor).Value = strMileCmmt
                        dest.Range("K" & cursor).Value = strRemCmmt
                        dest.Range("L" & cursor).Value = ActiveSheet.name
                        dest.Range("M" & cursor).Value = name
                        dest.Range("N" & cursor).Value = addDate
                                                
                        
                        cursor = cursor + 1
                        currentRow = currentRow + 1
                    End Select
            Loop

        End If
    End If
Next ws


Worksheets("BCMs").Select
'Delete columns GH in destination worksheet to fix merge issue
Columns("G:H").Delete Shift:=xlToLeft
Columns("J").Delete (xlToLeft)
Thank you.

I am trying to create a graph to track the data produced by a macro. The graph is already set up when the macro is started, but the range of data continually changes, and since the macro is an infinite loop until stopped by the user, there is no way of knowing beforehand the range of data the graph must find.

There doesn't seem to be a problem in doing this with one data series, but I would like to put a second data series on a secondary axis on the same graph. That is where the macro blows up and gives me this message:

Run-time error '1004':
Unable to set the Values property of the Series class.

Here's the code that causes me the problem:

If LoopCount > 5 Then
   Charts("Graph of Run").Select
   GraphRow = LoopCount + 2
   GraphColOne = Size + 3
   ActiveChart.SeriesCollection(1).Values = "=Petri!R3C[" & GraphColOne & "]:R[" & GraphRow
& "]C[" & GraphColOne & "]"
   GraphColTwo = GraphColOne + 1
   ActiveChart.SeriesCollection(2).Values = "=Petri!R3C[" & GraphColTwo & "]:R[" & GraphRow
& "]C[" & GraphColTwo & "]"
   End If
(Just as a note, the GraphColOne and GraphColTwo are from an attempt to correct this error by creating a second variable for the second series.)

If there's no known way of working around this, it wouldn't be a problem to split the data into separate charts, but for presentation purposes, I would like to have everything on one graph.

Any help?

Thanks.

HI.
I have about 8 pages of data i need to print.
I've been searching around for a macro that would set my print range automatically on daily bases.
These are the two macros that I found
Sub setprintarea()
Dim myrange As String
myrange = Cells(Rows.Count, 37).End(xlUp).Address
ActiveSheet.PageSetup.PRINTAREA = "$A$1:" & myrange
ActiveWindow.SelectedSheets.PrintOut Copies:=1

End Sub
----------------------------------
Sub PA()
Dim strLCell As String

With ActiveSheet
.UsedRange
'reset last cell
strLCell = .Cells.SpecialCells(xlCellTypeLastCell).Address
'get last cell address
.PageSetup.PRINTAREA = "$A$1:" & strLCell
'set the print area
End With

problem:

my worksheet has data in 37 columns, in first macro, if i change the Cells(Rows.Count, 37). to 36, it will print the correct number of pages with is 8, minus the last column. Now, if i switch replace 36 with 37, it will include the last column in the print range BUT, it will print 8 correct pages plus LOTS of other blank ones...how do i tell the macro to stop at 8 or whatever that page number happen to be.

btw. the second macro does the same thing. good colum number plus infinite pages..

thanks in advance

Hey all,

To me, it should not be creating infinite loop. It loops through outer array, checking if the end characters of a string match whats in the end_string array. Then for that string that was cleaned, it goes through another loop to remove any characters that match the second array. That is, if the index of second array is at all present in the cleaner string, then those characters should be removed from inner string. Then it outputs results in column B. Problem is when I run this macro, it causes excel to freeze and I have to force quit excel:

Sub StringChecker()

Dim string_arr() As Variant
Dim k As Integer

Dim c As Range
Set c = ActiveSheet.[A1]

end_string = Array(" &", _
            " TR", _
            " SR", _
            " DEFEN")
            
substring = Array(" JR ", _
            " SR ")

Do While c <> "End Loop"
            
   c.Offset(0, 1) = c
   
   For k = 0 To UBound(end_string)
   
      If Right(c, Len(end_string(k))) = end_string(k) Then
        cleaner_string = Mid(c, 1, Len(c) - Len(end_string(k)))
        
        For l = 0 To UBound(substring)

          clean_string = Replace(cleaner_string, end_string(l), "")
         

        Next l
         c.Offset(0, 1) = clean_string
      End If
       
   Next k
   
   

  
   Set c = c.Offset(1, 0)
Loop

End Sub
Force quitting excel is not the behavior I want. I was hoping it would convert this:

john smith JR & jennifer TR

to:

john smith & jennifer

thanks for response

Can anyone tell me if there is a way to sum one range of values depending on the contents of another range?

For example, lets say my spreadsheet has 4 columns:

-Column A has the name of the customer/company.
-Column B has the account numbers.
-Column C has each account's usage.
-Column D has usage totals (this is where I need help)

Companies/Customers often have more than one account and I need the sum of all the usages for accounts belonging to the same customer. Repeat customer names are always listed consecutively, ie if John has 5 accounts, A1:A5 will say "John".
Account numbers are each unique.
So... if A1:A5 says "John", I would like each cell in range D1:D5 to show the sum of C1:C5.

I know how to do all of this with defined criteria, ie if it were only three repeating customers... But we have an infinite number of customers and I need excel to group one range based on grouped values in another. In other words, if, a1:a5 contains "John" and a6:a8 contains "Bob", I want for it to sum only the John accounts together and then the Bob accounts together. Does that make sense?

If anyone could help, I would be infinitely grateful!! (I'm not so familiar with VBA and would of course prefer an Excel formula, but if there is a very SIMPLE VBA solution I can probably do it.)

Thanks!!

I'm making an eligibility chart based on income. If 1 person (equals a
household) makes between $0 and $1000 (household income) they are in "x"
category. if that person makes between $1001 and $2000, they are in "y"
category. If that person exceeds $2000, they are in "z" category. So I have
3 categories they can be included in (x=Free, y=reduced, z=paid...it isn't
just a true and false statement). The tricky part is the number of people in
the household. 2 to infinite # of people making in the range of $0-$1000
need to be in "free" category. 2 cells are being drawn from. A1 is the
number of people, A2 is the income, A3 is the formula for figuring their
eligibility. I need A3 to say "Free", or "Reduced", or "Paid" as the end
result of the data. Thank you for any help you may provide.

There are two sheets in the workbook. First sheet has certain values in a number of rows in a column. The second sheet also has values in each row in repeating patterns in a column. Like this:

   Sheet1          Sheet2
        A                   A
1  AAAA          gre1111assdf
2  BBBB          gfd2222dfhh
3  CCCC         jytjtu3333dgrt
4  DDDD         yufg4444fbth
5  EEEE          sdfs5555gfd
The macro is supposed to go through each row in Sheet2 per each row in the first sheet; assign a certain value to a variable when any given row in Sheet2 includes some other certain values; compare this variable's value to the row value in Sheet1 and quit once this process has been repeated for 4 rows in Sheet1:

Sub GetWpFromXMLs()
Application.ScreenUpdating = False

    Dim sRange As Range '// "source" Range ie. Sheet2
    Dim dRange As Range '// "destination" Range ie. Sheet1

    dRow = 0 '// "destination" Row  ie. Sheet1
    dCol = 2 '// "destination" Column ie. Sheet1
    sRow = 0 '// "source" Row ie. Sheet2
    
    Do
    Set dRange = ActiveSheet.Range("A1").Offset(dRow, 0)
    Set sRange = Sheets("Sheet2").Range("A1").Offset(sRow, 0)

    If InStr(1, sRange, "1111") > 0 Then critName = "AAAA" '// "AAAA" is the value of A1 in
Sheet1
    If InStr(1, sRange, "2222") > 0 Then critName = "BBBB" '// "BBBB" is the value of A2 in
Sheet1
    If InStr(1, sRange, "3333") > 0 Then critName = "CCCC" '// "CCCC" is the value of A3 in
Sheet1
    If InStr(1, sRange, "4444") > 0 Then critName = "DDDD" '// "DDDD" is the value of A4 in
Sheet1
    If InStr(1, sRange, "5555") > 0 Then critName = "EEEE" '// "EEEE" is the value of A5 in
Sheet1

    If dRange.Value = critName Then '// if the value extracted from the current Row in Sheet2 (sRange) matches the value of
the current row in Sheet1 (dRange)
        MsgBox critName '// show what value was extracted
        dRow = dRow + 1 '// since current row in Sheet1 was taken care of, move onto the next row for the next loop
        sRow = 0 '// start over from the first row in Sheet2 in the next loop
    Else
        sRow = sRow + 1 '// since the current row in Sheet2 didn't match the current row in Sheet1, move onto the next row in
Sheet2
    End If

    Loop Until dRow = 4 '// stop once first 3 rows in Sheet1 are taken care of

Application.ScreenUpdating = True
End Sub
This is supposed to stop once the match for the 3rd row in Sheet1 is found in Sheet2 but it only happens for the 1st row in Sheet1 and then goes into infinite loop.

I am very confused. Supposed to be that once a match for the first row of Sheet1 is made, dRow is incremented by 1 and thus looking for a match in for the second row of Sheet1 while sRow is reset to 0 so it starts from the first row of Sheet2 so as not to miss any rows. What is wrong here?


No luck finding an answer? You could always try Google.