Posts by mycomputerguy-w

Your second problem if i'm reading it right, If you get a match in column "H" you want the VBA to insert a column "I" and say "Matching" in the corresponding cell. If i am in fact assuming your needs correctly, than before any time is spent building this code, there is an issue straight off. A "Column" can only be inserted once so for example: if you have a match in cell A1, a column would be inserted that would then become column "I" and the word "Matching" would be inserted into "I1". If you had another match in A2, another column would be inserted and IT would then be Column "I". This would move your previous match one column to the right moving the word "Matching" into "J1". and so on. i hope this makes sense. It would be my opinion to just manually add the column and just set the code to give you the cell value of "Matching" rather than inserting a column.

Just for future reference, first thing to correct is your code should go in code tags. That's the "</>" symbol in the upper right corner.

Sub CompareColsaddcol()

Application.ScreenUpdating = False

Dim Rng As Range, RngList As Object, WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet, x As Long: x = 6

Set WS1 = ThisWorkbook.Sheets("WB1")

Set WS2 = Workbooks("sample_WB2.xlsx").Sheets("vulnerabilities.json-critical-o")

Set WS3 = Workbooks("sample_WB3.xlsx").Sheets("Sheet1")

Set WS4 = Workbooks("sample_WB4.xlsx").Sheets("Sheet1")

Set RngList = CreateObject("Scripting.Dictionary")

For Each Rng In WS1.Range("I2", WS1.Range("I" & Rows.Count).End(xlUp))

If Not RngList.Exists(Rng.Value) Then

RngList.Add Rng.Value, Nothing

End If

Next Rng

For Each Rng In WS1.Range("H2", WS1.Range("H" & Rows.Count).End(xlUp))

If RngList.Exists(Rng.Value) Then

WS1.Cells(Rng.Row, 8).Interior.ColorIndex = x

End If

Next Rng

RngList.RemoveAll

x = x + 1

For Each Rng In WS2.Range("F2", WS2.Range("F" & Rows.Count).End(xlUp))

If Not RngList.Exists(Rng.Value) Then

RngList.Add Rng.Value, Nothing

End If

Next Rng

For Each Rng In WS1.Range("H2", WS1.Range("H" & Rows.Count).End(xlUp))

If RngList.Exists(Rng.Value) Then

WS1.Cells(Rng.Row, 8).Interior.ColorIndex = x

End If

Next

RngList.RemoveAll

x = x + 1

For Each Rng In WS3.Range("Q2", WS3.Range("Q" & Rows.Count).End(xlUp))

If Not RngList.Exists(Rng.Value) Then

RngList.Add Rng.Value, Nothing

End If

Next Rng

For Each Rng In WS1.Range("H2", WS1.Range("H" & Rows.Count).End(xlUp))

If RngList.Exists(Rng.Value) Then

WS1.Cells(Rng.Row, 8).Interior.ColorIndex = x

End If

Next

RngList.RemoveAll

x = x + 1

For Each Rng In WS4.Range("B2", WS4.Range("B" & Rows.Count).End(xlUp))

If Not RngList.Exists(Rng.Value) Then

RngList.Add Rng.Value, Nothing

End If

Next Rng

For Each Rng In WS1.Range("H2", WS1.Range("H" & Rows.Count).End(xlUp))

If RngList.Exists(Rng.Value) Then

WS1.Cells(Rng.Row, 8).Interior.ColorIndex = x

End If

Next

Application.ScreenUpdating = True

End Sub

In the test book you sent me, the values in the "C" column are "ZL50GN(ARAI)"and"LW300FN(ARAI)" respectively. The values you have set in the code are "ZL50GV(ARAI)"and"LW300FV(ARAI)". ( Notice the "V" at the end of the number before the (ARAI) and an "N" in the same position in the the sheet data.)

Could this be the problem? This is why I wanted you to enter the data to check the values. Please check to be sure you are entering values correctly and let me know if this was or was not the issue.

just a quick thought as an edit. will a "For Each IX..... " call fix that problem? im thinking i would have to set iX into a variable format for that happen.?

Now I remember what the problem was after i put your fix in place. By putting the "Next iX" and "End With" at the end of the code, it doesn't matter what is checked in the listbox. It spits out an envelope for EVERY record. This particular project right now has 55,695 records in it. I have to be able to have it print only the records that are selected in the listbox.

No worries Roy, i just have 2 weeks to complete this project and this was holding me up. as far as the code above for the "Master Data" sheet, it was just something i was helping another user with and it may have got sent to you by accident. just disregard that code. ill try your fix and see if it works for me. i tried to move the "Next iX" and the "end with" to include the code for the envelopes before but got an error. ill try your fix and see if it works as needed.

again, thanks for the help. we need wizards like you for this stuff. ive learned a ton for you and hope to learn a lot more!

Cheers!

I think this is what you're talking about. Try this and see if it works for you. Please enter some data and see if the figures work out.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim ws As Worksheet, LRow As Long, DifValue As String
 Set ws = ThisWorkbook.Sheets("Master Data")
 With ws
 LRow = .Range("T" & .Rows.Count).End(xlUp).Row
 .Range("E4:E" & LRow).Formula = "=250 - (T4-L4)"
 .Range("F4:F" & LRow).Formula = "=600 - (T4-M4)"
 .Range("G4:G" & LRow).Formula = "=1000 - (T4-N4)"
 .Range("H4:H" & LRow).Formula = "=1000 - (T4-O4)"
 .Range("I4:I" & LRow).Formula = "=1000 - (T4-P4)"
 .Range("K4:K" & LRow).Formula = "=2000 - (T4-R4)"
 If ws.Cells(LRow, "C").Value = "ZL50GV(ARAI)" Or ws.Cells(LRow, "C").Value = "LW300FV(ARAI)" Then
 .Range("J4:J" & LRow).Formula = "=2000 - (T4-Q4)"
 Else
 .Range("J4:J" & LRow).Formula = "=1000 - (T4-Q4)"
 End If
 
 End With

End Sub

Glad i could help. Please don't forget like this thread and mark it as solved if you have no other issues.

good day!

OK, i think this is what you are wanting. Try this out and see if it works as you want it to.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim ws As Worksheet
    Dim LRow As Long
    Set ws = ThisWorkbook.Sheets("Master Data")
    With ws
    LRow = .Range("T" & .Rows.Count).End(xlUp).Row
    
    .Range("E4:E" & LRow).Formula = "=250 - L4-T4"
 End With
End Sub

Wait, i think i understand. To put it into simple terms, if column " T " is empty, skip that cell (no update) until a value is entered into column " T " then calculate it. Does that sound about right?

ok, so you want the code to only run when column " T " is updated or changed?

If i'm reading your request right, i'm thinking you are saying that you cant even get into the workbooks to view the data or the code. my suggestion would be to open excel and disable all macros then try to open the workbook. at that point, you could either fix the code or at least get into the workbook. if you don't know how to turn off the macros, go to Options>Trust Center>Trust Center Settings>Macro Settings and disable all macros. obviously this would be a temporary fix to allow you to at least get the book to load and then you could either fix the code or extract the data as needed. be sure to reset the option to the original setting when you are done.

BUMP

An even easier way.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ws As Worksheet
    Dim LRow As Long

    Set ws = ThisWorkbook.Sheets("Master Data")

    With ws
        LRow = .Range("E" & .Rows.Count).End(xlDown).Row

        .Range("E4:E" & LRow).Formula = "=250 - L4-T4"
    End With
End Sub

I not exactly sure how you'd need to set this up to work for what you're wanting to do but using something like:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim lastRow As Long, i As Integer, totalofEandL As Double, FinalSum As Double

Set FinalSum = Sheets("Master Data").Range("E4").end(xldown)


lastRow = Range("A5000").End(xlUp).Row

For i = 1 To lastRow
    totalofEandL = totalofEandL + WorksheetFunction.Sum(Range("L" & i & ":T" & i))
Next i
FinalSum = totalofEandL
End With

End Sub

Maybe this can put you on the right path or one of the experts can chime in and tweak this to work for you.

ok, updated sample attached. The part that is controlled by that sheet is working fine. All the data sheet holds at this point is the values from the settings page to build the rAddr. I will probably eliminate that sheet eventually and just use variables or something similar but for now, it is what it is.

Have a look, it should work for you now. Print only one record, it'll work just fine. Try to print more than one, it will only print the last alphabetical record you choose.

I'll try this again. Everything works fine as i stated before but where the problem starts is if you select multiple records in the listbox to print envelopes for. The code will see all the selections made, (I verified this with the debugger) but when it actually comes time to print the envelopes, it will only print the last record selected in the listbox. "Last" meaning the last alphabetically. I'm not sure on this one. Does the code need to print to the oDoc for each selection found? If so, that could turn into a nightmarish issue. ive included the code for the print function. Can someone take a look and see if they can figure out an answer to this issue? it has to print all selections, not just the last one.

Private Sub cmbtnPrint_Click()
 Dim otable As Range, r As Long, c As Long, sAddr As String, rAddr As String
 Dim oWord As Word.Application, oDoc As Word.Document
 
        With Me.ListBox1
            If .ListIndex = -1 Then Exit Sub '''/// no selection made
                ''///check if the current value is selected
            For iX = 1 To .ListCount
                ''///check if the current value is selected
                If .Selected(iX - 1) = True Then
                    sAddr = .List(iX - 1, 1) & " " & .List(iX - 1, 0) & vbCr & .List(iX - 1, 2) & vbCr & .List(iX - 1, 3) & " " & .List(iX - 1, 4) & " " & .List(iX - 1, 5)
                    rAddr = Sheets("Data").Range("A1").Value & vbCr & Sheets("Data").Range("A2").Value & vbCr & Sheets("Data").Range("A3").Value & vbCr & Sheets("Data").Range("A4").Value & ", " & Sheets("Data").Range("A5").Value & ", " & Sheets("Data").Range("A6").Value
                End If
            Next iX
        End With
            Set oWord = CreateObject("Word.Application")
            Set oDoc = oWord.Documents.Add
                
                If Me.ckbxAbsenteeBallot = True Then
                    'If Me.ckbxAbsenteeBallot Then
                        oDoc.Envelope.PrintOut , rAddr, , , sAddr, , , , "Size 12"
                    Else:
                    If Me.ckbxAbsenteeEnvelope = True Then
                        oDoc.Envelope.PrintOut , sAddr, , , rAddr, , , , "Size 14"
                    End If
                End If
                                
                ''/// pause macro for 5 seconds(approx)
                Application.Wait (Now + TimeValue("0:00:10"))
                    
            oWord.Quit False
End Sub

Thanks again for any and all help!!

bump

Just as i thought, after doing some deeper testing, there are more issues. Because im leaving for the rest of the day, ill just leave this here for you to look at and mess with later if you have time and i'll check it later to see if you have any ideas. Everything works fine as i stated before but where the problem starts is if you select multiple records in the listbox to print envelopes for. The code will see all the selections made, (I verified this with the debugger) but when it actually comes time to print the envelopes, it will only print the last record selected in the listbox. "Last" meaning the last alphabetically. I'm not sure on this one. Does the code need to print to the oDoc for each selection found? If so, that could turn into a nightmarish issue. The "sample" book i uploaded is just that, a sample. the actual database of names is in the tens of thousands. its already slow when it looks through to find the selected records, i cant imagine how slow it will be if it has to pause for each record to print. Maybe I'm thinking on too small of scale here? Maybe i need to look into doing this in access maybe?

VERY Cool Roy! That's what the problem was. The short pause gave it the ability to pop the dialog box. It works great now. And the combobox shows exactly what I wanted. I will use it to set a default printer for the application itself, at least that is the thought behind it at this moment. Thanks for all your help. Ill let you know how it all comes out. I'm going to wait to mark this thread as solved in case I have other related questions.

Have a good day!