Posts by AdamP1027

Hello,

I have this VBA (below) which will allow the summing of a list of numbers to reach a stated number.

When using =getcombination(A2:A9,C2) for example, where A2:A9 is a list of numbers, and C2 is the desired sum

However, the result is only 1 possible combination (and usually not a desired one). Is there a way to modify the VBA so the 1 combination shown is the result with the fewest number of combinations?

Function GetCombination(CoinsRange As Range, SumCellId As Double) As String
'updateby Extendoffice
    Dim xStr As String
    Dim xSum As Double
    Dim xCell As Range
    xSum = SumCellId
    For Each xCell In CoinsRange
        If Not (xSum / xCell < 1) Then
            xStr = xStr & Int(xSum / xCell) & " of " & xCell & "  "
            xSum = xSum - (Int(xSum / xCell)) * xCell
        End If
    Next
    GetCombination = xStr
End Function

Genius! So easy, thanks!

Is there any possibility of VBA (I'm imagining running in the sheet1 object), that will check the print area when attempting to print, if print area is unchanged since last print, then prompt with a warning?

I was able to record a macro using the filters, so thanks!

Yes I know I can do it with filters but was hoping for direct VBA instead

I know this is so easy, but it seems most people asking for this are asking for more complicated things.

What's the easiest way to look at column H, if any cell contains a certain word, then clear the whole cell?

Also, if any cell in column H contains a certain word, delete only that word.

Found a solution, thanks!

Option Explicit
Sub test()
Dim dic As Object
Dim Lr&, cell As Range, st As String
Set dic = CreateObject("scripting.dictionary")
Lr = Cells(Rows.Count, "A").End(xlUp).Row
    For Each cell In Range("A1:A" & Lr)
        If Not dic.exists(cell.Value) Then
            st = cell.Offset(0, 1).Value
            dic.Add cell.Value, st
        Else
            st = st & "; " & cell.Offset(0, 1).Value
            dic(cell.Value) = st
        End If
        If cell.Offset(1, 0).Value <> cell.Value Then cell.Offset(0, 2).Value = st
    Next
End sub

Whoops, I realized that I said columns C and D in my question but in my example sheet column D is blank.

So it should be columns C & E

If it would be easier, the results could go in the last row of the C, instead of the first row

Hello,

Please see attached worksheet.

I need VBA to look at column C. For all entries in column c that are the same, look at corresponding rows in column D, Paste all of those from column D into 1 cell in column F (first row of the associated column C entries), entries to be separated by a semicolon. I typed a couple entries in column F with the results that I want.

Thanks so much!

Nm I figured out the problem, something in the new data import from txt was messing up the VBA, I changed it to the legacy import and now the vba works.

Hi Dave,

Your above code doesn't work in excel 2019. Are you able to tell what is the matter?

Aha! I had tried this with A3:A500 but it didn't work, when I changed it to A1:A500 now it works!

That doesn't make sense to me but I'm happy that it works now. Thank you!

Hi again,

I have another sheet that I want to do the exact same thing, but the target that changes is B1, and the column that will have matches is A3:A500.

I tried adjusting the above code with these changes but it's not working, it seems to only color B1. Am I missing something? It seems like it should work.

It works like magic!

Hello,

Please see attached image.

Cell A6 changes all the time. Cell A6 will usually match some cell in row B. If A6 does match any cell in row B, that cell in row B needs to be colored green permanently.

I think I need to insert VBA into the sheet, starting with:

Private Sub Worksheet_Change(ByVal Target As Range)

This should trigger the code when target address changes? And then something like this? I'm guessing this will not get it done.

    If Target.Address = "$A:$6" And Range("A6") = Range("?") Then        ?.Interior.ColorIndex = 10    End If

End Sub

Absolutely brilliant!

It doesn't seem to do anything. I'm probably missing something obvious.
Sample file attached.

I have the following code which does something slightly similar but with different criteria and different "then". With enough trial and error I might be able to figure out how to get it transferred into what I need, but I'm guessing some expert here could probably do it in a couple minutes?

Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundRng As Range
    Dim sAddr As String
    For Each rng In Range("B10:B" & LastRow)
        If rng.DisplayFormat.Interior.Color = 5287936 And rng <> "" Then
            If rng.Offset(0, 4) <> "" Then
                rng.EntireRow.Select
            ElseIf rng.Offset(0, 4) = "" Then
                Set foundRng = Range("A:A").Find(rng.Offset(0, -1), LookIn:=xlValues, lookat:=xlWhole)
                If Not foundRng Is Nothing Then
                    sAddr = foundRng.Address
                    Do
                        If foundRng.Offset(0, 5) <> "" Then
                            foundRng.EntireRow.Select
                            Exit Do
                        End If
                        Set foundRng = Range("A:A").FindNext(foundRng)
                    Loop While foundRng.Address <> sAddr
                    sAddr = ""
                End If
            End If
        End If
    Next rng
    Application.ScreenUpdating = True


Dim lastCell As Long, p As Long


lastCell = Range("A:A").Find("*", , , , , xlPrevious).Row
ActiveCell.Interior.Color = 5296274
For p = 3 To lastCell
    If Cells(p, 1).Value = ActiveCell.Value Then Cells(p, 1).Resize(, 15).Interior.Color = ActiveCell.Interior.Color
Next p

Can anybody write VBA for this?

[If D10 is greater than 90] or [If E10 equals 2.6 or is greater than 11.99] then fill A10 red
If A10 is filled red and matches any other values in Column A, fill those red too.
Repeat for every row after 10