[RESOLVED] [Excel] Code to check cells into activeworkbook

[Bamahut]

Hi,

I'm trying to get a code to check 7 specific cells into my active workbook and if any of them has data in them to insert "X" into my closed workbook. This is part of another chunk of code as well to populate the closed workbook.

Dim wbksour As Workbook
Dim wbkdes As Workbook
Dim strSecondFile As String
Dim wksh As Worksheet

strSecondFile = "\\prc2507et001\IRFSSMP_31\IRFSS\_MAINTENANCE\Récup Info.xls" 'Path for destination document

Set wbksour = ActiveWorkbook() 'Use the activeworkbook regardless of name
Set wbkdes = Workbooks.Open(strSecondFile) 'Open the source workbook to copy the selected cells below
Screenrefresh = False
    nextrow = wbkdes.Sheets("Récup Info").Cells(wbkdes.Sheets("Récup Info").Rows.Count, 1).End(xlUp).Row + 1 'Select next row
        wbkdes.Sheets("Récup Info").Cells(nextrow, 1) = wbksour.Sheets("Bon de Travaux").Cells(28, 16) 'Copies P28 into Cell A2 of wbkdes.Sheets("Récup Info")
        wbkdes.Sheets("Récup Info").Cells(nextrow, 2) = wbksour.Sheets("Bon de Travaux").Cells(6, 6) 'Copies F6 into Cell B2 of wbkdes.Sheets("Récup Info")

If Not Application.Intersect(Target, wrksour.Range("H53,H55,H57,H59,H61,H63,H65")) Is Nothing Then
    If Target = "" Then
        wbkdes.Sheets("Récup Info").Cells(nextrow, 20) = "" 
            Else
                wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = "X"
    End If
    End If
    wbkdes.Save 'Save the Destination worksheet
    wbkdes.Close 'Close the Destination worksheet

So if the cells H53,H55,H57,H59,H61,H63,H65 have either a "X" or nothing it then runs the code.

I'm having a problem with "If Not Application.Intersect(Target, ". I think the problem is that it's trying to run those lines of codes on the destination workbook.

[westconn1]

what procedure is this code in? this also determines the target object

try like

for col = 53 to 65 step 2
    if not isempty(range("h" & col) then wbkdes.Sheets("Récup Info").Cells(nextrow, 20) = "X" : exit for
next

i may have misunderstood what result you want, but you should be able to modify to suit

[Bamahut]

what procedure is this code in? this also determines the target object

try like

for col = 53 to 65 step 2
    if not isempty(range("h" & col) then wbkdes.Sheets("Récup Info").Cells(nextrow, 20) = "X" : exit for
next

i may have misunderstood what result you want, but you should be able to modify to suit

The finish result I need is that if the cells H53,H55,H57,H59,H61,H63,H65 have an capital x, to then just insert an X into either column 20 on the destination work book else to insert an X into column 21.

I attached a screen shot of the cells I need to check and in turn the destination worksheet.

It's a bit complicated, I just hope it helps.

[westconn1]

maybe like this

wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = "X"
     for col = 53 to 65 step 2
        if range("h" & col).value = "X" then 
           wbkdes.Sheets("Récup Info").Cells(nextrow, 20) = "X" 
           wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = ""
           exit for
    next

[Bamahut]

maybe like this

wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = "X"
     for col = 53 to 65 step 2
        if range("h" & col).value = "X" then 
           wbkdes.Sheets("Récup Info").Cells(nextrow, 20) = "X" 
           wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = ""
           exit for
    next

Another problem just came up, I need to be able to check both "H" and "J" columns as they can both be ticked together, a work can be done internally and externally.This adds a new twist to the problem already in place.

I tried the code below but it doesn't work the way I want to:

    wbkdes.Sheets("Récup Info").Cells(nextrow, 22) = "X"
         For col = 53 To 65 Step 2
            If Range("h" & col).Value = "X" And Range("j" & col).Value = "" Then
               wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = "X"
               wbkdes.Sheets("Récup Info").Cells(nextrow, 22) = ""
               Else
                    If Range("h" & col).Value = "X" And Range("j" & col).Value = "X" Then
                        wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = "X"
                        wbkdes.Sheets("Récup Info").Cells(nextrow, 22) = "X"
                    End If
               End If
            Exit For
   Next

[westconn1]

I tried the code below but it doesn't work the way I want to:

what does it do?
how is that different from what you want?

[Bamahut]

what does it do?
how is that different from what you want?

So, to get the code working I had to let it monitor spaces.

    wbkdes.Sheets("Récup Info").Cells(nextrow, 22) = "X"
         For col = 53 To 65 Step 2
            If Range("h" & col).Value = "X" And Range("j" & col).Value = " " Then
               wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = "X"
               wbkdes.Sheets("Récup Info").Cells(nextrow, 22) = " "
               Else
                    If Range("h" & col).Value = "X" And Range("j" & col).Value = "X" Then
                        wbkdes.Sheets("Récup Info").Cells(nextrow, 21) = "X"
                        wbkdes.Sheets("Récup Info").Cells(nextrow, 22) = "X"
                    End If
               End If
            Exit For
   Next

To have a checked box like effect on our worksheet I used the code below, I ended up changing it to use spaces so it would get the code above working.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("J6,J8,J10,J12,J14,J16,J53,J55,J57,J59,J61,J63,J65,B30,B32,B34,B69,B71,H53,H55,H57,H59,H61,H63,H65,M30,M36,M38,M94,M96")) Is Nothing Then
If Target = " " Then
Target = "X"
Else: Target = " "
End If
End If
End Sub