Posts by rikcando

rikcando · Oct 25th 2017

Simple but it works.

Code

Sub ToggleColor()
Dim StartRow, iRow, EndColumn As Integer
Dim ShadeColor, UseColor As Single
Dim ShadeOn As Boolean


StartRow = 3
EndColumn = 25
'ShadeColor = -0.05  'lighter
 ShadeColor = -0.15  'medium
'ShadeColor = -0.25  'darker


ShadeOn = False




iRow = StartRow
Do
    If Cells(iRow, 3) <> Cells(iRow - 1, 3) Then
        If ShadeOn Then
            ShadeOn = False
            UseColor = 0#
        Else
            ShadeOn = True
            UseColor = ShadeColor
        End If
    End If


    ActiveSheet.Range(Cells(iRow, 1), Cells(iRow, EndColumn)).Select
    With Selection.Interior
        .Pattern = xlNone
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = UseColor
        .PatternTintAndShade = 0
    End With




    iRow = iRow + 1
Loop While Cells(iRow, 3) > ""


End Sub

Display More

rikcando · Feb 8th 2015

Re: Dynamic formula to pick text from a list with conditions

This macro will find if they exist on Sheet2 and create the list in A1 through A4 on Sheet3.
Again, this does not move any data from Sheet2.

Code

Private Sub getList()
Dim iRow As Integer
For iRow = 1 To 4
    Worksheets("Sheet3").Cells(iRow, 1) = ""
Next iRow
iRow = 1
If Worksheets("Sheet2").Cells.Find("Car") = "Car" Then
    Worksheets("Sheet3").Cells(iRow, 1) = "Car"
    iRow = iRow + 1
End If
If Worksheets("Sheet2").Cells.Find("Bus") = "Bus" Then
    Worksheets("Sheet3").Cells(iRow, 1) = "Bus"
    iRow = iRow + 1
End If
If Worksheets("Sheet2").Cells.Find("Bike") = "Bike" Then
    Worksheets("Sheet3").Cells(iRow, 1) = "Bike"
    iRow = iRow + 1
End If
If Worksheets("Sheet2").Cells.Find("Taxi") = "Taxi" Then
    Worksheets("Sheet3").Cells(iRow, 1) = "Taxi"
    iRow = iRow + 1
End If
End Sub

Display More

rikcando · Feb 8th 2015

Re: Dynamic formula to pick text from a list with conditions

My apologies. I did not see the word 'move'. This will copy, not move.
I canot move the values without VBA.

I also see that you are looking at the entire sheet, not just a column.

rikcando · Feb 8th 2015

Re: Dynamic formula to pick text from a list with conditions

No.
The VLOOKUP function requires at least two columns, even if you are only using 1.
These formulas will go into cells A1 through A4 in your output sheet.

Column I is simply a placeholder to avoid an error.
Column H is the column that holds the data to be searched.

rikcando · Feb 8th 2015

Re: Dynamic formula to pick text from a list with conditions

You will need to adjust the VLOOKUP range that I have used (Sheet2!H:I) to match your data.
Select the column that you wish to check and the column to the right of it.

rikcando · Feb 8th 2015

Re: Dynamic formula to pick text from a list with conditions

Maybe...

Cell A1
=IFERROR(VLOOKUP("Car",Sheet2!H:I,1,FALSE),(IFERROR(VLOOKUP("Bus",Sheet2!H:I,1,FALSE),IFERROR(VLOOKUP("Bike",Sheet2!H:I,1,FALSE),(IFERROR(VLOOKUP("Taxi",Sheet2!H:I,1,FALSE),"None"))))))
Cell A2
=IF(A1="Car",(IFERROR(VLOOKUP("Bus",Sheet2!H:I,1,FALSE),(IFERROR(VLOOKUP("Bike",Sheet2!H:I,1,FALSE),IFERROR(VLOOKUP("Taxi",Sheet2!H:I,1,FALSE),"None"))))),(IF(A1="Bus",(IFERROR(VLOOKUP("Bike",Sheet2!H:I,1,FALSE),(IFERROR(VLOOKUP("Taxi",Sheet2!H:I,1,FALSE),"None")))),(IF(A1="Bike",(IFERROR(VLOOKUP("Taxi",Sheet2!H:I,1,FALSE),"None")),"None")))))
Cell A3
=IF(A2="Bus",(IFERROR(VLOOKUP("Bike",Sheet2!H:I,1,FALSE),(IFERROR(VLOOKUP("Taxi",Sheet2!H:I,1,FALSE),"None")))),(IF(A2="Bike",(IFERROR(VLOOKUP("Taxi",Sheet2!H:I,1,FALSE),"None")),"None")))
Cell A4
=IF(AND(A3<>"None",A3<>"Taxi"),IFERROR(VLOOKUP("Taxi",Sheet2!H:I,1,FALSE),"None"),"None")

rikcando · Feb 8th 2015

Re: Compare Column on one work sheet to 3 columns on another

Quote from olsonj23;737828

What I'm trying to do is to compare the values in column B on sheet 3 to the values in Column A on Sheet 2, the values in column B on sheet 2, and the values in column c on sheet 2. So if the values appear in any of the three column change the color of the cell to yellow.

I am stil not sure which columns that you are trying to compare so I create a generic subroutine that you can use.
It take the names of the sheets as source and compare (as strings), and the source and compare columns.

Code

Sub TestCompare(sSrcSht As String, sCmpSht As String, iSrcCol As Integer, iCmpCol As Integer)
Dim lSrcRow, lCmpRow As Long
Dim sCol As String
Dim sSrcTxt, sCmpTxt As String


sCol = Chr(64 + iSrcCol)  'sets column to a 1 character Ascii string (65==A)
    
For lSrcRow = 1 To Worksheets(sSrcSht).Cells(Rows.Count, sCol).End(xlUp).Row
    sSrcTxt = Trim(Worksheets(sSrcSht).Cells(lSrcRow, iSrcCol).Text)
    sCol = Chr(64 + iCmpCol)
    For lCmpRow = 1 To Worksheets(sCmpSht).Cells(Rows.Count, sCol).End(xlUp).Row
        sCmpTxt = Trim(Worksheets(sCmpSht).Cells(lCmpRow, iCmpCol).Text)
        If StrComp(sSrcTxt, sCmpTxt, vbTextCompare) = 0 Then
            Worksheets(sCmpSht).Cells(lCmpRow, iCmpCol).Interior.Color = RGB(255, 255, 0)
        End If
    Next lCmpRow
Next lSrcRow
End Sub

Display More

To call is like this. I have tested this on sheets with 500+ rows. It takes some time to go through all of the rows, but it works.

Code

Sub doTest()
TestCompare "CamTableSample", "CamTableSample2", 1, 1
TestCompare "CamTableSample", "CamTableSample2", 2, 2
TestCompare "CamTableSample", "CamTableSample2", 1, 3
End Sub

Hope that helps.

rikcando · Sep 24th 2011

Re: Compare the contents of a cell to a range of cells

Sorry apollo, guess I fell asleep on the job.
Thanks LogheadLeech for picking up my slack.
Looks like your in good hands appollo, back to my nap.

rikcando · Sep 24th 2011

Re: Compare the contents of a cell to a range of cells

If you need to add further rows you could change the definition of the origRng like so.

Code

Set origRng = Range("B3:B4")

And move the definition of compRng to within the Rng1 loop and define it using the Rng1 row.

Code

For Each Rng1 In origRng
       Set compRng = Range("C" & Rng1.Row & ":AH" & Rng1.Row)

rikcando · Sep 24th 2011

Re: Compare the contents of a cell to a range of cells

Your range origRng is missing the quotes.

Try this. It compares the strings both in upper case to catch any misaligned cases.
It also checks to see it the string in B3 is the start of the string in Rng2.

Code

Sub FindDuplicates()
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim bMatch As Boolean
    Dim origRng As Range
    Dim compRng As Range
    On Error Resume Next
    Set origRng = Range("B3")
    If origRng Is Nothing Then Exit Sub
    Set compRng = Range("C3:AH3")
     
    For Each Rng1 In origRng
        bMatch = False
        For Each Rng2 In compRng
            If InStr(UCase(Rng2), UCase(Rng1)) = 1 And Rng2 > "" Then
                bMatch = True
                Rng2.Interior.ColorIndex = 6
            End If
        Next Rng2
        If bMatch = False Then
            Rng1.Interior.ColorIndex = 3
        Else
            Rng1.Interior.ColorIndex = -4142
        End If
    Next Rng1
End Sub

Display More

I also added changing the colorindex back to -4142 if the match was found. I was testing this and the cell turns red if no match was found, but was not cleared if the string in cell B3 was changed.

rikcando · Sep 24th 2011

Re: Time stamp not working as desired

Try using 'Target' instead of 'Activecell'. The target cell is the one that created the event.

rikcando · Sep 24th 2011

Re: Macro to obtain values every second

Could you not use Worksheet_Change and copy the values over as they appear in column B?

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 Then
        Sheet2.Range("A1").Value = Target.Value
    End If
End Sub

rikcando · May 2nd 2011

Re: Macro to move text within cell

Krishnakumar, thanks for the article. I do often have a lot of those pesky "" in my code and the article offers some interesting tips.

rikcando · May 2nd 2011

Re: Macro to move text within cell

Quote

How to do I run It??

First of all, sorry it took so long to get back here to answer your question. Busy week, son just got married.

As for your question, simply press F5 from the VBA environment while the cursor is within the code. Or press the 'play' button. You could put a button on teh sheet itself and assign it to the macro.

rikcando · Apr 24th 2011

Re: Macro to move text within cell

Quote

Option Compare Text

Cytop, thank you very much for this note. I have been using LCase and UCase since GWBasic and I did not know of this seemingly newer option. I guess even an old hack like me can learn something.

rikcando · Apr 24th 2011

Re: Boolean Function Issue

Another quick fix would be to just remove the 'else statement.

rikcando · Apr 24th 2011

Re: Boolean Function Issue

Oh, I see it now. I think I would just 'exit for' to avoid wasting time checking the rest of the shapes. Nice catch Mike.

rikcando · Apr 24th 2011

Re: Boolean Function Issue

Maybe the issue is in the calling sub routine. Are you sure that you are sending a worksheet object and a string?

rikcando · Apr 24th 2011

Re: Boolean Function Issue

I just pasted the code into a new spreadsheet (Excel 2010), inserted a shape called 'thisone' and added the following code. Your function worked fine and returned TRUE.

Code

Public Sub testshp()
   Dim tobetrue As Boolean
      tobetrue = LabelExists(Worksheets(1), "thisone")
End Sub

rikcando · Apr 24th 2011

Re: Macro to move text within cell

Cytop, I looked over your code and (I may be wrong, but) it looks like it places each new keyword at the begining of the text string. this would result in 'screw Gearbox' instead of 'Gearbox screw'.

Also, in my example I did not account for character case, so 'Gearbox' would not be found if the keyword was 'gearbox'. The following change would fix this.

Change

Code

iPos = InStr(sTmp, sKey)

to

Code

iPos = InStr(LCase(sTmp), LCase(sKey))