Free Microsoft Excel 2013 Quick Reference

VBA UDF Loop in Range function

I'm pulling my hair out trying to solve this:

I have a UDF such that

	VB:
	
 range 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Expire and price are adjacent columns with dates and prices. I want to loop through the expire range (column of dates) and select the corresponding price in the next column if expire < startdate. Then, if .Edate(startdate, 1) < current expire value, stick with the current expire value, ELSE next expire value. I want to do this loop 17 times. If you're confused, please ask, but any responses are appreciated, I'm extremely confused! (new VBA user). Thank you!


Post your answer or comment

comments powered by Disqus
Hi All,
I am just presenting the vba code below for sorting all columns (A4:T379) based on a value in a single column (M)
Selection.AutoFilter Field:=rownumber, Criteria1:="<01-Feb-2011", Operator:=xlAnd
    Range("A4:T379").Sort Key1:=Range(M3), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
The above code sorts the range from A4 to T379 which is nothing but the data below the column headings which has autofilter in it.

My question:
Is it possible to substitute A4 and T379 with two variables which contains the address of the first cell and the last cell in the range. If so, Can anyone provide me with a syntax to substitute variables for A4 and T379 in the range function.

Adv. Thanks for the help.
KK

Hi. Trying to speed up a macro that utilizes the instr function. Attached is a sample workbook. Is there a way to exit the loop early to maximize speed in this macro?

Thanks

Sample code:

Sub crosschecker()
Dim nombre As Range
    Set nombre = Sheets("NAME2").Range("A2:A31195")
For Each ce In Range("A1:A8")
'Nombre
    For i = 0 To 31194
        If InStr(1, LCase(ce), LCase(nombre(i))) > 0 Then ce.Offset(0, 3).Value = nombre(i, 2)
        Next i
Next ce
End Sub


Hi,

I have a peice of code that filters a column for zero values and returns the rowcount. I tried looping over different columns. The problem is when I pass a variable in range function as

.Range(sWord).AutoFilter Field:=1

(where sword is the variable.) Irrespective of the value of sword , my program filters Column A1. I am pasting my code below. could someone please help me


	VB:
	
 
Sub findrcn() 
    Dim wsStart As Worksheet 
    Dim sWord As String 
    Dim RowCount As Integer 
    Dim i As Long 
    Dim j As Long 
    Dim l As Long 
    Dim k As String 
    Dim Final As Integer 
    Dim lastrow As Integer 
    Dim rng As Range 
     
     
     
     
    Set wsStart = ActiveSheet 
     'this loop is to check if a sheet exists
    For j = 1 To Worksheets.Count 
        k = Worksheets(j).Name 
        If UCase(k) = UCase("Analysis") Then 
            lastrow = ((Sheets("Analysis").Range("A" & Rows.Count).End(xlUp).Row) + 1) 
        Else 
            lastrow = 0 
        End If 
         
    Next j 
    MsgBox "finished checking the sheets" 
     
    For Each rng In Range("A1:B1").Columns 
        sWord = Replace(rng.Address(RowAbsolute:=False), "$", "") ''Now I am trying to loop over all the columns
        If lastrow = 0 Then 
            Sheets.Add After:=Sheets(Sheets.Count) 'Adding a new sheet
            Sheets(Sheets.Count).Name = "Analysis" 
            wsStart.AutoFilterMode = False 
             
            With wsStart 
                .Range(sWord).AutoFilter Field:=1, Criteria1:="=0" 'if my column contains a 0 in it filter that
                 
                With .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible) 
                    Final = .Count 'get the count of the number of rows after the filter
                    RowCount = Final - 1 
                    MsgBox RowCount 
                End With 
                 
                Sheets("Analysis").Range("A") = RowCount 'paste it in the analysis tab
                 
            End With 
            wsStart.AutoFilterMode = False 
             
             
        Else 
             
            wsStart.AutoFilterMode = False 
             
             
            With wsStart 
                .Range(sWord).AutoFilter Field:=1, Criteria1:="=0" 'if my column contains a 0 in it filter that
                MsgBox sWord 
                With .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible) 
                    Final = .Count 
                    MsgBox "final" 
                    RowCount = Final - 1 ' to account for column name
                    MsgBox RowCount 
                End With 
                 
                Sheets("Analysis").Range("A" & lastrow) = RowCount 'paste it in the analysis tab
                 
                 
            End With 
            wsStart.AutoFilterMode = False 
            MsgBox "I am editing the existing sheet" 
             
             
        End If 
    Next rng 
     
End Sub 

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


Thanks for your solutionOgilvy! but am not able to make the macro work. And
thanks to all you programmers who has
helpt me with my questions.
(It's not easy to be an Copy and Paste Programmer!)

My problem is that I want to calculate every cell to the right from
"RngMdDp1", based on the value on every cell in "RngMdDp1"That meens
cells(O2:O115). compare to the value in cell (I3)

Example:
The Cell that is used to see witch calculation to use
Cell ("I3") value = 1358

Example of the breaking point I wont in the ("RngMdDp1")
Cell ("O55") value = 1355. Then it uses the first Calculation.
"=(RC[-1]*RC[-2])"
Cell ("O56") value = 1357. Then it uses the first Calculation.
"=(RC[-1]*RC[-2])"
Cell ("O57") value = 1359. Then it uses the second Calculation. "=(RC[-1])"
Cell ("O57") value = 1361. Then it uses the second Calculation. "=(RC[-1])"

I hope that I have explain so you anderstand my problems.
Below is some of the macro I have used. That dont work.
-----------------------------------------------------------------------------------
Sub DrillPipe1()
Dim c as Range
For Each c In Range("RngMdDp1")
If c.Value < Range("I3") Then
c.Offset(0, 1).FormulaR1C1 = _
"=(RC[-1]*RC[-2])"
Else
c.Offset(0, 1).FormulaR1C1 = "=(RC[-1])"
End if
Next c
End Sub
---------------------------------------------------------------------------------
Sub DrillPipe1()
For Each cell_in_loop In Range("RngMdDp1")
If (cell_in_loop.Value > Range("I3").Value) Then
cell_in_loop.Offset(0, 1).FormulaR1C1 = _
"=(RC[-1]*RC[-2])"
Else
cell_in_loop.Offset(0, 1).FormulaR1C1 = "=(RC[-1])"

Exit For
End If
Next cell_in_loop

End Sub

Thanks for you'rs time
Aksel

Thanks for your solutionOgilvy! but am not able to make the macro work. And
thanks to all you programmers who has
helpt me with my questions.
(It's not easy to be an Copy and Paste Programmer!)

My problem is that I want to calculate every cell to the right from
"RngMdDp1", based on the value on every cell in "RngMdDp1"That meens
cells(O2:O115). compare to the value in cell (I3)

Example:
The Cell that is used to see witch calculation to use
Cell ("I3") value = 1358

Example of the breaking point I wont in the ("RngMdDp1")
Cell ("O55") value = 1355. Then it uses the first Calculation.
"=(RC[-1]*RC[-2])"
Cell ("O56") value = 1357. Then it uses the first Calculation.
"=(RC[-1]*RC[-2])"
Cell ("O57") value = 1359. Then it uses the second Calculation. "=(RC[-1])"
Cell ("O57") value = 1361. Then it uses the second Calculation. "=(RC[-1])"

I hope that I have explain so you anderstand my problems.
Below is some of the macro I have used. That dont work.
-----------------------------------------------------------------------------------
Sub DrillPipe1()
Dim c as Range
For Each c In Range("RngMdDp1")
If c.Value < Range("I3") Then
c.Offset(0, 1).FormulaR1C1 = _
"=(RC[-1]*RC[-2])"
Else
c.Offset(0, 1).FormulaR1C1 = "=(RC[-1])"
End if
Next c
End Sub
---------------------------------------------------------------------------------
Sub DrillPipe1()
For Each cell_in_loop In Range("RngMdDp1")
If (cell_in_loop.Value > Range("I3").Value) Then
cell_in_loop.Offset(0, 1).FormulaR1C1 = _
"=(RC[-1]*RC[-2])"
Else
cell_in_loop.Offset(0, 1).FormulaR1C1 = "=(RC[-1])"

Exit For
End If
Next cell_in_loop

End Sub

Thanks for you'rs time
Aksel

Ways To Restrict Loops in Excel VBA
Restricting Excel VBA LoopsEXCEL VBA: Restricting LoopsI would like to show you 2 ways to restrict looping by using the COUNTIF Function with the Find Method. The 1st code uses a whole cell match, while the 2nd uses a part cell match.The key thing to note in both codes is our use of the range variable rFound in the Find Method parameter for After: That is, After:=rFound. By using this we can move down the Column and find all matches. If we didn't use this, we always find the 1st match over and over again.
Sub RestrictLoop1WholeCellMatch()
Dim rFound As Range
Dim lLoop As Long

With Range("A:A")
'Set our range variable to the 1st cell in Column A
Set rFound = .Cells(1, 1)

'Use COUNTIF to restrict our looping
For lLoop = 1 To WorksheetFunction.CountIf(.Cells, "Dave")
'Use the Find Method and set each parameter to suit whole cell match
Set rFound = .Find(What:="Dave", After:=rFound, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

With rFound
'Your .With code here
End With
Next lLoop
End With
End Sub

Dim rFound As Range
Dim lLoop As Long

With Range("A:A")
'Set our range variable to the 1st cell in Column A
Set rFound = .Cells(1, 1)

'Use COUNTIF to restrict our looping
For lLoop = 1 To WorksheetFunction.CountIf(.Cells, "*Dave*",)
'Use the Find Method and set each parameter to suit part cell match
Set rFound = .Find(What:="Dave", After:=rFound, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

With rFound
'Your .With code here
End With
Next lLoop
End With
End Sub


Hi All,

I have a row of cells that contain text. Depending on the text i want to convert it to a specific value (0,1, or 2) so that my sum function will work properly


	VB:
	
 
Option Explicit 
 
Public Function SumBackBar(backbars) As Variant 
    Dim cell As range 
    Dim backbars As range 
     
    SumBackBar = 0 
     
    For Each cell In backbars 
         
        If cell.Value = "3S" Then cell.Value = 1 Else 
        If cell.Value = "5S" Then cell.Value = 1 Else 
        If cell.Value = "5FSH" Then cell.Value = 1 Else 
        If cell.Value = "3FSH" Then cell.Value = 1 Else 
        If cell.Value = "NO" Then cell.Value = 0 Else 
        If cell.Value = "" Then cell.Value = 0 Else 
        If cell.Value = "-" Then cell.Value = 0 Else 
        If cell.Value = "0" Then cell.Value = 0 Else 
        If cell.Value = 0 Then cell.Value = 0 Else 
        If cell.Value = 1 Then cell.Value = 1 Else 
        If cell.Value = "2 3S" Then cell.Value = 2 Else 
        If cell.Value = "2 5S" Then cell.Value = 2 Else 
        If cell.Value = "2 3FSH" Then cell.Value = 2 Else 
        If cell.Value = "2 5FSH" Then cell.Value = 2 
         
        SumBackBar = SumBackBar + cell 
    Next cell 
     
     'Application.WorksheetFunction.Sum (backbars.Cells)
     
End Function 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
I am not sure with some of the coding, like options explicit.

I want to be able to select a cell (not in the range) and have it call my UDF, SumBackBar, once I specify what the range of cells is. Basically have it work like the built in Sum function.

Thanks for your help,
siddowens123

Good morning experts!

Hoping you guys can help, I'm a real noobie with VBA but found a lot of great info from this site so hoping maybe someone can shed some light onto my predicament!

I'll try to keep this concise but here goes;

Basically I am using web queries to create a report, within each web query is a link to another report (drilled down version) to which I am performing a web query on as well.

This continues between 3 and 4 levels everytime posting the web query underneath each time, this is for aproximately 30 different pages all importing different data,

At the moment I'm using a custom function I found online (sorry not sure where can't give the credit!)


	VB:
	
 
    retVal = "" 
    If forThisCell.Hyperlinks(1).Address  "" Then 
        retVal = forThisCell.Hyperlinks(1).Address 
    End If 
    getURL = retVal 
End Function 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
And this code for the web query


	VB:
	
 Range 
For Each rngURL In Range("RangeName").Cells 
     
    Sheets("Sheet1").Select 
     
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & rngURL.Value, _ 
        Destination:=Range("A65536").End(xlUp).Offset(1)) 
        .Name = "Import" 
        .FieldNames = True 
        .RowNumbers = False 
        .FillAdjacentFormulas = False 
        .PreserveFormatting = True 
        .RefreshOnFileOpen = False 
        .BackgroundQuery = True 
        .RefreshStyle = xlInsertDeleteCells 
        .SavePassword = False 
        .SaveData = True 
        .AdjustColumnWidth = True 
        .RefreshPeriod = 0 
        .WebSelectionType = xlSpecifiedTables 
        .WebFormatting = xlWebFormattingAll 
        .WebTables = "2" 
        .WebPreFormattedTextToColumns = True 
        .WebConsecutiveDelimitersAsOne = True 
        .WebSingleBlockTextImport = False 
        .WebDisableDateRecognition = False 
        .WebDisableRedirections = False 
        .Refresh BackgroundQuery:=False 
    End With 
Next 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
To import the 2nd table on each page with full formatting (so it brings the url).

To make this work I have to post a formula like =GETURL(Sheet1!$A1) then copy it down however many cells are required prior to running the macro (e.g. aprox 3000 at the moment), which across 30 reports amounts to a fair amount of data!

What I would like to do is have the macro insert the formula as each web query is done and determine if the URL taken contains specific text then STOP the web queries, e.g. if the url contains the word "tech" then STOP the web queries www.reportsystem/report1/30/01/2011/tech1.html.

I currently use a formula for this =IF(ISNUMBER(SEARCH("tech",GETURL(Sheet1!$A1))),"Tech Data Here",GETURL(Sheet1!$A1)) to try and stop it which does work but I feel is very messy!

Now that I feel I have rambled on long enough a quick summary!

Sheet1 has URL links, web query macro runs, pulls links from here, inserts web queries which then makes the GETURL formulas on Sheet1 update with more links and continues the process until all data is complete!

Anyone manage to stay with me through that???

Thanks ever so much for any advice!

Hi,

I did quite some searching but could not find a solution which worked.

I need a function which can run a sensitivity analysis on existing sheet, i.e. it is a table function which takes a range as parameter, goes through each value in range, adjusts it by the specified value and reads the result of calculation from the sheet and the final ouput goes to a table.

Everything would be great but I simpy can not change the value of the cell in the loop. The function terminates and returns #Value!

I tried different way to refer to these cells and I can read the current value, but cannot change it. Any ideas?

Here is the code:

	VB:
	
) 
     
    Dim n As Integer, i As Integer 
    Dim Result() As Double 
     
    n = InputValues.Rows.Count 
    Redim Result(1 To n, 1 To 6) 
    i = 0 
     
    For Each c In InputValues 
        i = i + 1 
         
        Result(i, 1) = InputValues(i) * LowStress 
        Result(i, 2) = InputValues(i) 
        Result(i, 3) = InputValues(i) * HighStress 
         
        c.Value = Result(i, 1) 
        Result(i, 4) = Range("Valuation").Value 
    Next c 
     
    Sensitivity = Result 
     
End Function 

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


When I set a "for each cell in range" to go through the range, and if there are merged cells in this range, this will result an endless loop. Any one know why?

I have two ranges, b2:b8 and c2:c8. I would like the two ranges to multiply each other, for example: b2 * c2, b3 * c3, etc. I would like the result to be outputted into d2:d8. I have started on something, but it definately isn't working. Here is what I have. Thanks

Private Sub ComputePayment_Click()

Dim myRange As Range
Dim myRange2 As Range
Dim Payment As Double
Dim TotalHours As Double
Dim HourlyRate As Double

For Each myRange In Range("b2:b8")

With myRange.Offset(0, 0)

TotalHours = myRange.Value

.Value = TotalHours
End With

Next myRange

For Each myRange2 In Range("c2:c8")

With myRange2.Offset(0, 0)

HourlyRate = myRange2.Value

.Value = HourlyRate
End With

Next myRange2

For Each myRange3 In Range("d2:d8")

With myRange3.Offset(0, 0)

Payment = TotalHours * HourlyRate

.Value = Payment

End With
Next myRange3

End Sub

I know that it is basically looping through the ranges and only doing the math of the last two cells, but I do not know how to do it otherwise. I was thinking on somehow embedding the one range into the other, but didn't work so well either. Thanks again

IĀ“m triyng to use a variable content in a Range function without success,
Example:

LINHAREF = 10
Do While LINHAREF < 40
Lk = "K" + Str(LINHAREF)
MsgBox Range(Lk)
LINHAREF = LINHAREF +1
Loop

Hi, I've written a short VBA function to give a Boolean true when a number value is referenced which is in the E96 resistor range. The code looks like this:
Function resE96(resistance As Double) As Boolean
    Dim normRes As Double
    Dim prefRes As Double
    
    'Immediately exit function with 'false' result if input is zero
    If (resistance = 0#) Then
        resE96 = False
        Exit Function
    End If
    
    'normalise the resistance value
    normRes = normalise(resistance)
    
    'for each value in range compare a normalised input with theoretical value
    'if a match is found return a 'true' result and exit function
    For i = 0 To 95
        prefRes = CDbl(Round(10 ^ (i / 96), 2)) 'equation for nth res value in series: 10 ^ (n / E)
                                                'where E is range E number. in this case E96
        If (normRes = prefRes) Then
            resE96 = True
            Exit Function
        End If
    Next i
End Function
Function normalise(x As Double) As Double

    'multiply or divide 'x' by 10 until in scientific form (without exponent)
    If (x < 1) Then
        Do While (x < 1)
            x = x * 10
        Loop
    ElseIf (x > 9) Then
        Do While (x > 9.99)
            x = x / 10
        Loop
    End If
    normalise = x
End Function
It works fine up until the equality test, where i have sporadic success. For example if the value passed to the function is 1, the equality test evaluates as true and proceeds accordingly. However if the value passed is 107, the equality test evaluates as false despite normRes and prefRes being the same value and datatype. I am new to VBA, though i do have experience in c++, it is possible i am missing something fundamental. Any help would be greatly appreciated.

Ben

Does anyone know how to detect when a UDF is being edited in the
Function Wizard? I need to know because my function takes a long time
to calculate, so I want to switch off calculation attempts until data
entry is complete. My idea is that if I know the Function Wizard is
active then I can just skip the calculation.

I have already tried looking at Application.Caller but this seems to
return a range whether in the Function Wizard or not.

IĀ“m triyng to use a variable content in a Range function without success,
Example:

LINHAREF = 10
Do While LINHAREF < 40
Lk = "K" + Str(LINHAREF)
MsgBox Range(Lk)
LINHAREF = LINHAREF +1
Loop

Hi, I'm trying to create a UDF to sum a 5 period range where if the range contains text the range is expanded.

Data
10
20
--
32
--
--
--
25
30
--
40
55

This is what I've created so far, but I'm stuck. Could someone have a look improve the code, I'm so rusty at excel its embarrassing. Thanks

PHP Code: 
Public Function SumAndSkip(ER As Long, C As Long, P As Long) As Long


    Application.Volatile

    Dim iRows As Long  'Infected Rows
    Dim SR As Long     'Start Row
    Dim iNum As Long
    
    Dim finished As Boolean

    Dim I As Long

    With ActiveSheet

        SR = (ER - (P - 1))   StartRow = (EndRow-Parameter)
    
        iRows = Application.WorksheetFunction.CountIf(.Cells(SR, C).Resize(ER, C), "--")

        If iRows > 0 Then

            Do Until finished = True
            
                SR = SR - 1
            
                If Not .Cells(SR, C) = "--" Then
                
                    iRows = iRows - 1
                
                End If
                
                If iRows = 0 Then finished = True
                
                I = I + 1
                
            Loop
            
            ER = P + I
        
        End If

        SumAndSkip = Application.Sum(.Cells(SR, C).Resize(ER, C))

    End With

End Function 


I successfully filled up a multidimensional array, now I want to make use of it as a parameter in a function, but I'm getting a subscript-out-of-range error. Any suggestions?

The code below is not intended to run, just enough excerpts to clue you in.


	VB:
	
 engine() 
     
    Dim z() As Variant 
    z = imdbScrape 
     
     '**** PLEASE HELP ME MAKE THIS PART WORK - arrayPreview FUNCTION IS AT END****
     
    arrayPreview (Array(z)) '*****************************************************
     
     '**** PLEASE HELP ME MAKE THIS PART WORK - arrayPreview FUNCTION IS AT END****
     
    tstMov = 1 
    tstCrt = 1 
    tstItm = 1 
    Do While z(tstMov, tstCrt, tstItm)  "" 
        tstItm = tstItm + 1 
        If z(tstMov, tstCrt, tstItm) = "" Then 
            tstCrt = tstCrt + 1 
            tstItm = 1 
            If z(tstMov, tstCrt, tstItm) = "" Then 
                tstMov = tstMov + 1 
                tstCrt = 1 
                tstItm = 1 
            End If 
        End If 
         
        If tstCrt = 11 Then 
            Exit Do 
        End If 
    Loop 
     
     
    Function imdbScrape() As Variant 
         'searches imdb for titleS, and digs deeper for data
         
        Dim oSh As Worksheet 
        Dim myIe As Object 
         
        Dim V(1 To 25, 1 To 10, 1 To 200) As Variant '10 movies, 10 criteria, each with a list up to 200-long 'THE ORIGINAL
ARRAY DECLARATION
         
        For cl = 12 To 12 Step 2 '2 To 12 Step 2
            For rw = 7 To 9 
                V(movNum, 1, 1) = Cells(rw, cl).Text 
                title = V(movNum, 1, 1) 
                If myIe Is Nothing Then 
                    Set myIe = CreateObject("InternetExplorer.Application") '''''''''''''''''''''''''''''''''''''''''''''
                End If 
                 
                searchLink = imdbSearchLink(title) 'GENERATE SEARCHLINK FOR IMDB.COM
                myIe.Visible = True 
                myIe.Toolbar = False 
                myIe.StatusBar = False 
                myIe.MenuBar = False 
                myIe.Navigate URL:=searchLink 
                While myIe.busy 
                    DoEvents 
                Wend 
                 
                 'TYPICAL DIG
                V(movNum, 7, 1) = mKRat 
                V(movNum, 2, itemNum) = current 
                V(movNum, 3, itemNum) = current 
                V(movNum, 4, itemNum) = current 
                V(movNum, 5, itemNum) = Left(current, InStr(current, "|") - 2) 
                V(movNum, 5, itemNum) = current 
                V(movNum, 8, 1) = Left(current, InStr(current, "(") - 2) 
                V(movNum, 9, 1) = current 
                 
                imdbScrape = V 
            End Function 
             
             
            Function arrayPreview(arr As Variant) 
                 
                Dim i As Integer 
                Dim sh As Worksheet 
                 
                 'output data to sheets, 1 movie per sheet
                For i = 1 To 25 'movies
                    itm = 1 
                     
                    For t = 1 To 10 'criteria
                        lRw = sh.Cells(10000, t).End(xlUp).Row 
                        Do Until arr(i, t, itm) = "" 
                            lRw = sh.Cells(10000, t).End(xlUp).Row 
                             
                            sh.Cells(lRw + 1, t) = "|" & arr(i, t, itm) & "|" 
                            itm = itm + 1 
                            lRw = lRw + 1 
                        Loop 
                    Next t 
                     
                    Set sh = Sheets(ActiveSheet.Index + 1) 
                Next i 
                 
            End Function 

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


Hey guys,

I have a spreadsheet that I am trying to create a button that will reference a cell value (Item Number), find that value in rows A40:A90, copy the value in the row from column C:AG, and then paste said values in range (C19:AG19). The problem is that I need it to keep the validation lists and formulas. This is the current VBA that I am working with, and its really close, but I cant figure out how to keep my validation lists. I also cant keep my formulas AND my formatting - only one or the other.

This code is to keep the formulas - I had another working code that would keep the formatting (special paste values) and would get rid of the formulas.


	VB:
	
 
Dim Rng As Range 
FindString = Sheets("Sheet1").Range("E37").Value 
If Trim(FindString)  "" Then 
    With Sheets("Sheet1").Range("A40:A90") 
        Set Rng = .find(What:=FindString, _ 
        After:=.Cells(.Cells.Count), _ 
        LookIn:=xlValues, _ 
        LookAt:=xlWhole, _ 
        SearchOrder:=xlByRows, _ 
        SearchDirection:=xlNext, _ 
        MatchCase:=False) 
        If Not Rng Is Nothing Then 
            Rng.Select 
            Selection.Offset(0, 1).Select 
             
        End If 
         
    End With 
    With ActiveCell 
        Range(Cells(.Row, "C"), Cells(.Row, "AG")).Select 
        Selection.Copy 
        Range("C19").Select 
        ActiveSheet.Paste 
         
    End With 
End If 
End Sub 

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


Hi guys,

well here goes right away my question

What I want to do is loop through a defined range that includes various columns. Now to achieve what I want, it is necessary to loop through this range vertically (first, column A from lines 1 to n, then column B lines 1 to n and so on) - instead of the normal horizontal way. At least thats how VBA looped through when I tried this.

Does anybody know how to tell this to VBA?
Actual code looks like that:


	VB:
	
 ...() 
     
    Dim temp 
     
    For Each cl In Range("SomeRange") 
        If Not IsEmpty(cl) Then 
            temp = cl.Text() 
        Else: cl.Value = temp 
        End If 
    Next cl 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
I know I could achieve the same result defining a range for each column, but I somewhat what look to do it this way.

In hope for a quick answer thanks a lot!
Toby

Hi,

What is the equivalent VBA code for the excel function =Count(A1:A4) ?

I want the range to be from A1 to the last value in the column.

Thanks

This loop is overwriting the first cell in range and not writing to the first blank cell in range.


	VB:
	
 NOTE 
    If Trim(cnote).Value = "" Then 
        cnote.Value = notes.Value 
        Exit For 
    Else 
    End If 
Next cnote 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
If I take out the exit for , it copies to all cells in range

thanks

I have a bit of VBA code that loops through a range and looks at the color index. If it is color index three then it will put a "1" in the cell six columns over. This code works, but I see over and over again that loops are bad and inefficient. Since I am working on my code being more efficient I wanted suggestions for altrenate code that would do basically the same thing.

Thanks for any help you can provide.


	VB:
	
 Range 
For Each Bcell In Range("D2:D304") 
    If Bcell.Interior.ColorIndex = 3 Then 
        Bcell.Offset(0, 6) = "1" 
    Else 
        Bcell.Offset(0, 6).ClearContents 
    End If 
Next Bcell 

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


Hi!

I just cannot seem to figure this one out - please help!

The bottom line is: I want to determine whether a value exists in a column and get beyond #N/A error values if it does not.

I have a range (B15:B26) in which the months of the year that are applicable in a specific situation will be entered using this formula in B16 and copied down to B26:

=IF(D16

I am looking for a formula function or a vba code where:

- In workbook1 find the first cell that is empty between range A7 -
A10,
- In workbook2, in Range G10- G13: find the word "Day1".
- If the word "Day1" exists in cells G10 or G11 or G12 or G13, copy
the particular cell or cells where "Day1" exists to the first found
empty cell or cells in range A7-A10 in workbook1.

Lets suppose cells A8, A9, A10(workbook1) are empty cells, that means
A8 is the first empty cell.
And G10,G11,G12, G13 (workbook2) have the word "Day1"
Then,
Copy cell G10 into cell A8
Copy cell G11 into cell A9
Copy cell G12 into cell A10

Please let me know if this explanation is confusing.... and I can try
explaining again.

Appreciate all help!


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