Help needed to change column reference in Macro Code

G

galbatrox9

New Member
Joined
Aug 30, 2017
Messages
23
Hi,

I have an excel workbook which has has a macro written for an older format of file we maintained , can the cell references be changed to match my new format of file?

This is the code :-
Code: 
Sub testextract()Application.DisplayAlerts = False
Application.ScreenUpdating = False


Dim i, j, k, l, flg, lt_rw1, lt_rw2 As Integer
Dim t1, t2, t3 As String


ThisWorkbook.Sheets("input").Activate


lt_rw1 = ThisWorkbook.Sheets("Input").Range("A65536").End(xlUp).Row
lt_rw2 = ThisWorkbook.Sheets("Name").Range("A65536").End(xlUp).Row


If (lt_rw1 > 1) Then
    For i = 2 To lt_rw1
        For l = 1 To 4
            If Cells(i, l).Value = "" Then
                Exit For
            Else
                t1 = UCase(Cells(i, l).Value)
                For j = 2 To lt_rw2
                    For k = 2 To 4
                        If (ThisWorkbook.Sheets("Name").Cells(j, k).Value = "") Then
                            flg = 0
                            Exit For
                        Else
                            t2 = UCase(ThisWorkbook.Sheets("Name").Cells(j, k).Value)
                            t3 = UCase(ThisWorkbook.Sheets("Name").Cells(j, 1).Value)
                            If InStr(1, t1, t2) > 0 Then
                                Cells(i, 5).Value = t3
                                flg = 1
                                Exit For
                            Else
                                flg = 0
                                Cells(i, 5).Value = "Not Available"
                            End If
                        End If
                    Next k
                    If (flg = 1) Then
                        Exit For
                    End If
                Next j
            End If
            If (flg = 1) Then
                Exit For
            End If
        Next l
    Next i
End If


Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Name Extracted Successfully..!", vbOKOnly + vbInformation, "Issuer Extracted"


End Sub

There are two sheets involved in the code. This is sheet "Input"
tV1Gd75.png


This is the sheet "Name"
KVqHWuX.png





Now in the new format of my file, the columns for the sheet "Input" have changed to the below (Columns needed F,G,H,I and P):

h9sucm5.png




I cant understand the code written by my team. Can someone fix this please?
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Maybe this code will help you:
Code: 
Option Explicit

Sub TestExtract()
    Dim I As Integer, J As Integer, K As Integer, L As Integer
    Dim Flg As Integer, Lt_Rw1 As Integer, Lt_Rw2 As Integer
    Dim T1 As String, T2 As String, T3 As String
    Dim Sht1 As Worksheet, Sht2 As Worksheet
    
    Set Sht1 = ThisWorkbook.Sheets("Input")
    Set Sht2 = ThisWorkbook.Sheets("Name")
    Lt_Rw1 = Sht1.Range("A" & Rows.Count).End(xlUp).Row
    Lt_Rw2 = Sht2.Range("A" & Rows.Count).End(xlUp).Row
    If Lt_Rw1 = 1 Then Exit Sub
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For I = 2 To Lt_Rw1
        For L = 6 To 9
            If Sht1.Cells(I, L).Value = "" Then Exit For
            T1 = UCase(Sht1.Cells(I, L).Value)
            For J = 2 To Lt_Rw2
                For K = 2 To 4
                    If Sht2.Cells(J, K).Value = "" Then
                        Flg = 0
                        Exit For
                    Else
                        T2 = UCase(Sht2.Cells(J, K).Value)
                        T3 = UCase(Sht2.Cells(J, 1).Value)
                        If InStr(1, T1, T2) > 0 Then
                            Sht1.Cells(I, 16).Value = T3
                            Flg = 1
                            Exit For
                        Else
                            Flg = 0
                            Sht1.Cells(I, 16).Value = "Not Available"
                        End If
                    End If
                Next K
                If Flg = 1 Then Exit For
            Next J
            If Flg = 1 Then Exit For
        Next L
    Next I

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Name Extracted Successfully!", vbOKOnly + vbInformation, "Issuer Extracted"
End Sub
 
Upvote 0
ChrisGT7 said:
Maybe this code will help you:
Code: 
Option Explicit

Sub TestExtract()
    Dim I As Integer, J As Integer, K As Integer, L As Integer
    Dim Flg As Integer, Lt_Rw1 As Integer, Lt_Rw2 As Integer
    Dim T1 As String, T2 As String, T3 As String
    Dim Sht1 As Worksheet, Sht2 As Worksheet
    
    Set Sht1 = ThisWorkbook.Sheets("Input")
    Set Sht2 = ThisWorkbook.Sheets("Name")
    Lt_Rw1 = Sht1.Range("A" & Rows.Count).End(xlUp).Row
    Lt_Rw2 = Sht2.Range("A" & Rows.Count).End(xlUp).Row
    If Lt_Rw1 = 1 Then Exit Sub
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For I = 2 To Lt_Rw1
        For L = 6 To 9
            If Sht1.Cells(I, L).Value = "" Then Exit For
            T1 = UCase(Sht1.Cells(I, L).Value)
            For J = 2 To Lt_Rw2
                For K = 2 To 4
                    If Sht2.Cells(J, K).Value = "" Then
                        Flg = 0
                        Exit For
                    Else
                        T2 = UCase(Sht2.Cells(J, K).Value)
                        T3 = UCase(Sht2.Cells(J, 1).Value)
                        If InStr(1, T1, T2) > 0 Then
                            Sht1.Cells(I, 16).Value = T3
                            Flg = 1
                            Exit For
                        Else
                            Flg = 0
                            Sht1.Cells(I, 16).Value = "Not Available"
                        End If
                    End If
                Next K
                If Flg = 1 Then Exit For
            Next J
            If Flg = 1 Then Exit For
        Next L
    Next I

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Name Extracted Successfully!", vbOKOnly + vbInformation, "Issuer Extracted"
End Sub
Click to expand...

Chris, will it be possible for the code to color the cells that pull "Not Available" as red?
 
Upvote 0
Try this one instead:
Code: 
Option Explicit

Sub TestExtract()
    Dim I As Integer, J As Integer, K As Integer, L As Integer
    Dim Flg As Integer, Lt_Rw1 As Integer, Lt_Rw2 As Integer
    Dim T1 As String, T2 As String, T3 As String
    Dim Sht1 As Worksheet, Sht2 As Worksheet
    
    Set Sht1 = ThisWorkbook.Sheets("Input")
    Set Sht2 = ThisWorkbook.Sheets("Name")
    Lt_Rw1 = Sht1.Range("A" & Rows.Count).End(xlUp).Row
    Lt_Rw2 = Sht2.Range("A" & Rows.Count).End(xlUp).Row
    If Lt_Rw1 = 1 Then Exit Sub
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For I = 2 To Lt_Rw1
        For L = 6 To 9
            If Sht1.Cells(I, L).Value = "" Then Exit For
            T1 = UCase(Sht1.Cells(I, L).Value)
            For J = 2 To Lt_Rw2
                For K = 2 To 4
                    If Sht2.Cells(J, K).Value = "" Then
                        Flg = 0
                        Exit For
                    Else
                        T2 = UCase(Sht2.Cells(J, K).Value)
                        T3 = UCase(Sht2.Cells(J, 1).Value)
                        If InStr(1, T1, T2) > 0 Then
                            Sht1.Cells(I, 16).Value = T3
                            Flg = 1
                            Exit For
                        Else
                            Flg = 0
                            Sht1.Cells(I, 16).Value = "Not Available"
                            With Sht1.Cells(I, 16).Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .Color = 255
                                .TintAndShade = 0
                                .PatternTintAndShade = 0
                            End With
                        End If
                    End If
                Next K
                If Flg = 1 Then Exit For
            Next J
            If Flg = 1 Then Exit For
        Next L
    Next I

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Name Extracted Successfully!", vbOKOnly + vbInformation, "Issuer Extracted"
End Sub
 
Upvote 0
ChrisGT7 said:
Try this one instead:
Code: 
Option Explicit

Sub TestExtract()
    Dim I As Integer, J As Integer, K As Integer, L As Integer
    Dim Flg As Integer, Lt_Rw1 As Integer, Lt_Rw2 As Integer
    Dim T1 As String, T2 As String, T3 As String
    Dim Sht1 As Worksheet, Sht2 As Worksheet
    
    Set Sht1 = ThisWorkbook.Sheets("Input")
    Set Sht2 = ThisWorkbook.Sheets("Name")
    Lt_Rw1 = Sht1.Range("A" & Rows.Count).End(xlUp).Row
    Lt_Rw2 = Sht2.Range("A" & Rows.Count).End(xlUp).Row
    If Lt_Rw1 = 1 Then Exit Sub
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For I = 2 To Lt_Rw1
        For L = 6 To 9
            If Sht1.Cells(I, L).Value = "" Then Exit For
            T1 = UCase(Sht1.Cells(I, L).Value)
            For J = 2 To Lt_Rw2
                For K = 2 To 4
                    If Sht2.Cells(J, K).Value = "" Then
                        Flg = 0
                        Exit For
                    Else
                        T2 = UCase(Sht2.Cells(J, K).Value)
                        T3 = UCase(Sht2.Cells(J, 1).Value)
                        If InStr(1, T1, T2) > 0 Then
                            Sht1.Cells(I, 16).Value = T3
                            Flg = 1
                            Exit For
                        Else
                            Flg = 0
                            Sht1.Cells(I, 16).Value = "Not Available"
                            With Sht1.Cells(I, 16).Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .Color = 255
                                .TintAndShade = 0
                                .PatternTintAndShade = 0
                            End With
                        End If
                    End If
                Next K
                If Flg = 1 Then Exit For
            Next J
            If Flg = 1 Then Exit For
        Next L
    Next I

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Name Extracted Successfully!", vbOKOnly + vbInformation, "Issuer Extracted"
End Sub
Click to expand...

This changed all the Names extracted to Red. Can this be done only for the ones which populate 'Not Available'? Also i was sort of looking for changing the font color and not the cell's background. Is it much different?
 
Last edited:
Upvote 0
I hope this one is the code you are looking for:
Code: 
Sub TestExtract()
    Dim I As Long, J As Long, K As Byte, L As Byte
    Dim Flg As Boolean, Lt_Rw1 As Long, Lt_Rw2 As Long
    Dim T1 As String, T2 As String, T3 As String
    Dim Sht1 As Worksheet, Sht2 As Worksheet
    
    Set Sht1 = ThisWorkbook.Sheets("Input")
    Set Sht2 = ThisWorkbook.Sheets("Name")
    Lt_Rw1 = Sht1.Range("A" & Rows.Count).End(xlUp).Row
    Lt_Rw2 = Sht2.Range("A" & Rows.Count).End(xlUp).Row
    If Lt_Rw1 = 1 Then Exit Sub
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For I = 2 To Lt_Rw1
        For L = 6 To 9
            If Sht1.Cells(I, L).Value = "" Then Exit For
            T1 = UCase(Sht1.Cells(I, L).Value)
            For J = 2 To Lt_Rw2
                For K = 2 To 4
                    If Sht2.Cells(J, K).Value = "" Then
                        Flg = False
                        Exit For
                    End If
                    T2 = UCase(Sht2.Cells(J, K).Value)
                    T3 = UCase(Sht2.Cells(J, 1).Value)
                    
                    If InStr(1, T1, T2) > 0 Then
                        Sht1.Cells(I, 16).Value = T3
                        Flg = True
                        Exit For
                    End If
                    
                    Sht1.Cells(I, 16).Value = "Not Available"
                    Sht1.Cells(I, L).Font.Color = vbRed
                    Flg = False
                Next K
                If Flg Then Exit For
            Next J
            If Flg Then Exit For
        Next L
    Next I


    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Name Extracted Successfully!", vbOKOnly + vbInformation, "Issuer Extracted"
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Change character when show in textbox on userform based on optionbutton
Replies
5
Views
363
MKLAQ
M
G
  • Solved
Help needed with simple macro
2
Replies
15
Views
232
MARK858
MARK858
K
  • Question Question
VBA DOUBT- can we add heading color and remove blank columns in this code?
Replies
0
Views
170
Kishore1982
K
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
162
Joe4
Joe4
K
  • Question Question
Select the Name in the Data Validation list on a cell value then the same name run the sub macro
Replies
9
Views
461
kpmsivaprakasam2003
K

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top