VBA If Range equals Active Cell then paste "Specific Text" to corresponding column

[Falko26]

Hey Team,

I'm trying to write a VBA code to fill in the status column of a table with either "Open" or "Closed" based on if the job number column of the table equals the active cell selected. I'm working between two sheets.

What I'm trying to do is select a specific job number from the Project Information list on sheet "Received %".
Then run the "Open Project" Macro which will look to the sheet "Open" and if column "Job Number" = Active cell then paste the word "Open" into corresponding cells in the column "Status"

Then ill duplicate this code to make a "Close Project" Macro to do the opposite action.

Otherwise if using the active cell value doesn't work I thought we could do a "Open Project" Macro that brings up a list of unique Job Numbers from the "Open" sheet that you can pick from to do the same action. but that's a little advanced for my knowledge not even sure if that's an option.

But I would like to add a Message box at the end that asks the user if they are sure they want to "Close" or "Open" said Job Number before running Macro.

Sheet "Received %"

Sheet "Open"

Thanks!

 

[Engberg]

Does this work? It assumes that job numbers are in column B, Status in column I and P.
Also, instead of having two separate macros for open and close, maybe just one macro that toggles from/to Open/Closed in both Received % and Open, what do you think?

Sub sub_open()
 Dim foundCell As Range
 
 userAnswer = MsgBox("Are you sure you want change status to open?", vbQuestion + vbYesNo, "User Repsonse")

 If userAnswer = vbYes Then
  With Sheets("Open")
      Set foundCell = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Find(ActiveCell.Value)
   
      If foundCell Is Nothing Then
          MsgBox ("Can't find that")
      Else
      .Cells(foundCell.Row, "P").Value = Sheets("Received %").Cells(ActiveCell.Row, "I").Value
      End If
  End With
 Else
 End If
End Sub

 

[Falko26]

Hey Engberg,

This is a really good start!

However it looks like the code is trying to take the value found in Column I in the "Received %" sheet and paste it into column P in the "Open" sheet? Column I is actually a VlookUp so it gets its value from the "Open" Sheet itself. Instead of using a specific cell for the paste value I was thinking we could just type the word "Open"?

Something like this?
.Cells(foundCell.Row, "P").Value = "Open"

Also I'm trying to get the word "Open" to paste in every Cell in Column "P" that has the corresponding matching Job Number in Column B instead of just the first one.

The reason for the two separate macros is because at the end of the day I'd like to make clickable buttons on the Excel sheet "Received %" that say open and close so the operator can click on the project "Job Number" he wants to change then click on either the open or close button to initiate the macro. Then all of the data rows associated with that job number on the "Open" sheet will get updated on project status.

Thanks again for your help with this!

 

[Engberg]

So like this?

Sub sub_open()
    Dim foundCell As Range
    Dim firstAddress As String
    Dim searchRng As Range
   
    selJobNr = ActiveSheet.Cells(ActiveCell.Row, "B").Value
    userAnswer = MsgBox("Are you sure you want change status to OPEN for job number " & selJobNr & "?", vbQuestion + vbYesNo, "User Repsonse")
   
    If userAnswer = vbYes Then
        With Sheets("Open")
            Set searchRng = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
            Set foundCell = searchRng.Find(What:=selJobNr, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
           
            If foundCell Is Nothing Then
                MsgBox ("Can't find that")
            Else
                firstAddress = foundCell.Address
                Do
                    .Cells(foundCell.Row, "P").Value = "Open"
                    Set foundCell = searchRng.FindNext(foundCell)
                Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
            End If
        End With
    Else
    End If
End Sub

 

[Falko26]

99% !!

This is perfect for the information iv given you so far! And I will except this as a solution.

I took your code and it worked perfectly to set the status of the project to "Open". But there is one final part to this spreadsheet. I have a third sheet named "Closed" and macros set up in the sheets to automatically move full rows worth of data between the sheets depending on the status of the column.

I copied the code you sent and made the "Closed" version. After it found and set the first status column cell to closed the row was moved to the "closed" sheet and the macro errored out. I'm assuming this is because your code references the found cell to find the next one? If there's a way to bypass that then this spreadsheet will be completed.

I can email you the Workbook if your interested in seeing it.

Thanks again this has been a ton of help!

 

[Fluff]

I can email you the Workbook if your interested in seeing it.

Please do not do that as it is against board rules.
If you wish to share the workbook please upload it to a file share site & post the link to the thread

 

[Falko26]

I see. Ye send the workbook and I'll see if I can make them not interfere with eachother.

Hey Engberg,

Here is the Link to the Workbook for you to take a look at.

Link:
https://badlandscont-my.sharepoint....dGtNvDdAetorsBpt__dvoBCd1kqpK_N60MmQ?e=FAUcyj

Hopefully that works,
Let me know!

 

[Fluff]

How about

Sub Falko()
   With Sheet2.ListObjects("Open")
      .Range.AutoFilter 1, ActiveCell.Value
      If .Range.Columns(1).SpecialCells(xlVisible).Count > 1 Then
         .ListColumns("Status").DataBodyRange.SpecialCells(xlVisible).Value = "Open"
      Else
         MsgBox "No match"
      End If
      .AutoFilter.ShowAllData
   End With
End Sub

 

[Engberg]

This seems to work for the close button:

Sub BLC_Status_Closed()
    Dim foundCell As Range
    Dim firstAddress As String
    Dim searchRng As Range
   
    selJobNr = ActiveSheet.Cells(ActiveCell.Row, "B").Value
    userAnswer = MsgBox("Are you sure you want change status to CLOSED for job number " & selJobNr & "?", vbQuestion + vbYesNo, "User Repsonse")
   
    If userAnswer = vbYes Then
        With Sheets("Open")
        
            Do
                Set searchRng = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
                Set foundCell = searchRng.Find(What:=selJobNr, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
                If foundCell Is Nothing Then
                    MsgBox ("Can't find (any more) rows with that job number")
                    Exit Do
                Else
                    .Cells(foundCell.Row, "P").Value = "Closed"
                End If
            Loop
        End With
    Else
    End If
End Sub

 

[Falko26]

Perfect Engberg!

Works without a hitch. This worksheet will greatly help our companies inventory keeping abilities!
Yours works as well Fluff so thank you!

I have to ask, where did you guys learn to write VBA code like this? I'd love to dive more into the how to. Is there some online resources better than others that I could explore?