Search column G then copy F number to right side C column

Hello and good day to all Experts Exchange users and helpers. I am trying to have this work in this way.

Search for column "G" and find all with number that has 1 on column G.

***If there is a number 1 on column G
***Then On that row search for a number on the F column.
***Have number found on column F display on the right corner of the C column

Again guys thanks for your time and help.

Search-column-G-then-copy-F-number-t.png
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim dccolumn As Integer
Dim dcvalue As String

dccolumn = ActiveCell.Column
dcvalue = ActiveCell.Value


If Application.Intersect(ActiveCell, [headers]) Is Nothing Then

       Range("C2").Value = Target.Value
        Cancel = True
        
       If ActiveCell.Value <> "" Then
        
        ActiveSheet.ShowAllData
        
         ActiveSheet.ListObjects("Table134").Range.AutoFilter Field:=5, Criteria1:=Selection.Text, Operator:=xlOr, Criteria2:="DIVIDER"
        

        
        End If
    
    End If
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' You should always Dim your variables. If you place "Option Explicit" (without the quotes)
    ' at the top of the module you will be required to do that. It may be a pain but it will
    ' not allow spelling mistakes that cause bugs thyat are difficult to find.
    Dim lngLastRow As Long
    Dim lngRow As Long
    ' NOTE
    Const LAST_COL = "L"
    
    lngLastRow = Range("A1048576").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
            Dim rownumber As Integer

            rownumber = ActiveCell.Row

            ' If it's not a header row, turn cells in the clicked row yellow when a non-blank
            ' cell in the row is clicked
            If Application.Intersect(ActiveCell, [headers]) Is Nothing Then
               If ActiveCell.Value <> "" Then
                  Range("a1:" & LAST_COL & "5000").Interior.ColorIndex = xlNone
                  Range("a" & rownumber & ":" & LAST_COL & rownumber).Interior.Color = RGB(255, 255, 9)
               End If
            End If

    For r = 1 To 4
        Select Case r
            Case 1
                bgW = "ACTIVE"
                bg = RGB(255, 0, 0)     '   FF  00  00
            Case 2
                bgW = "ON DECK"
                bg = RGB(255, 102, 0)   '   FF  66  00
            Case 3
                bgW = "ON HOLD"
                bg = RGB(153, 102, 0)   '   99  66  00
            Case 4
                bgW = "COMPLETED"
                bg = RGB(0, 153, 51)     '   00  99  33

        End Select
        bgR = 0
        On Error Resume Next
            bgR = Application.Match(bgW, ActiveSheet.Range("C:C"), 0)
        If bgR > 0 Then Range("A" & bgR & ":" & LAST_COL & bgR).Interior.Color = bg
    Next r
    
      ' Color row if column "H" is L or Z
    For lngRow = 5 To lngLastRow
        Select Case UCase(Cells(lngRow, "H"))
            Case "L"
                Range("A" & lngRow & ":" & LAST_COL & lngRow).Interior.Color = 13408767 'RGB(255, 153, 204) Medium Light Red
            Case "Z"
                Range("A" & lngRow & ":" & LAST_COL & lngRow).Interior.Color = 16711680 'RGB(204, 255, 255) Medium Light Blue
        End Select
    Next
         
                
    Select Case ActiveCell.Interior.Color
        Case 13408767, 16711680
            ' It's light red or light blue so change it to yellow
            Range("A" & ActiveCell.Row & ":" & LAST_COL & ActiveCell.Row).Interior.Color = 655359 ' RGB(255, 255, 9) Yellow
    End Select
                

Open in new window

completed-9-24-open.xlsm
Omar HernandezAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
Subodh Tiwari (Neeraj)Connect With a Mentor Excel & VBA ExpertCommented:
Okay try the attached.
I have tweaked the code to add the numbers within the parenthesis.
completed-9-24-open.xlsm
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may try something like this....

Place the following code on a Standard Module not on Sheet module.
Sub FindAndPlaceValuesInColumnC()
Dim lr As Long
Dim rng As Range, cell As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With Range("G3:G" & lr)
   .AutoFilter 1, 1
   If Range("G3:G" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      Set rng = Range("F4:F" & lr).SpecialCells(xlCellTypeVisible)
      For Each cell In rng
         Cells(cell.Row, "C") = Trim(Replace(cell.Value, "*", ""))
      Next cell
   End If
   .AutoFilter
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
Omar HernandezAuthor Commented:
Hello Neeraj i do add this code on the standard module, but no luck any other suggestion.
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
To place the code on a Standard Module, open VB Editor --> Insert --> Module --> and paste the code into the opened code window.

The code will not run automatically as it is not an event code so you will need to run this code by pressing the either F5 key after clicking inside the code or press Alt+F8 to open macro window and select the code and click on Run.
Or you can insert a command button from the Form Controls on the sheet and assign the code to that button so that you can run this code by clicking the command button itself.
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
I downloaded your file and noticed that you have table on the sheet so I have tweaked the code accordingly and inserted a button on the sheet called "Populate Column C". You may click that button to run the code.
completed-9-24-open.xlsm
0
 
Omar HernandezAuthor Commented:
The code that you have provided works up to a degree.

The code does input the number, but it delete any information that has written on that cell.

Any way to have any word that is on that "C" column where the number will be input ignore and add the number on the right without it affecting the words on the left?
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Okay see if this does what you are trying to achieve....
completed-9-24-open.xlsm
0
 
Omar HernandezAuthor Commented:
Hey Neeraj, when i keep on pressing the ( POPULATE COLUMN C) button it duplicate's the input

May it be possible to have it in a way that we may code it like this

Numbers being sent from "F" column to Column "C" have it inside a special character () or ** looking like this. 2 being sent to the C column will look like this *2*. So that when i click on the (POPULATE COLUMN C) button it will search for the special character ** erase anything there and then input the new information.

If there is *2* on the "C" column and on the F column i change the number to a 1 if i click on the (POPULATE COLUMN C) it will work as follow.  *2* to erase any information inside the ** and then input new information *1*
0
 
Omar HernandezAuthor Commented:
Hello there Neeraj it worked marvelous, can i implement this code to work in conjunction of a button that has another code. So that when i click on this button both function will be executed in one click.

Private Sub CommandButton4_Click()
'
' refresh Macro
'

'
    ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort.SortFields. _
        Add Key:=Range("Table134[[#All],[TIMER]]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort.SortFields. _
        Add Key:=Range("Table134[[#All],[TASK]]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort.SortFields. _
        Add Key:=Range("Table134[[#All],[ORGANIZER]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("GENERAL").ListObjects("Table134").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Unload Me
End Sub

Open in new window

0
 
Omar HernandezAuthor Commented:
Once again thanks Neeraj a mil for your help and time. Works great.
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Omar!
0
All Courses

From novice to tech pro — start learning today.