VBA code to replace NULL

[Mangosteenlu]

Hi,

I wonder if someone can help me with the VBA code which would make this tedious task so much easier. Thank you very much in advance.

I am working on the analysis for the below data. NULL in column E and F need to be replaced same as the one (not NULL) with the same reference number in Column C. For example, the one highlighted in green color in Column E and F need to be replaced by 52PU001H and EXP6451 respectively as they have the same reference number in Column C (AD01S35838). If column E with the reference of '_TRSP' just leave as it is.

 

[offthelip]

The problems arise when you have got two different stock numbes and AVL EQU code e.g. for AD10P35836, do you want "_Delivery" or "HG40/0001" and how do we tell which to use?

 

[ranman256]

Run: FixNullCols
add more columns to fix if needed

Sub FixNullCols()

Range("E1").Select
Fix1ColNull

   'DO MORE NEEDED COLUMNS
'Range("f1").Select
'Fix1ColNull
End Sub


Public Sub Fix1ColNull()  'of activecell
Dim vWord, vUsrSrt, vUsrEnd, vFirst, vLast
Dim i As Integer

On Error Resume Next

Cells(1, ActiveCell.Column).Select
While ActiveCell.Value <> ""
   If ActiveCell.Value = "NULL" Then ActiveCell.Value = ""

   ActiveCell.Offset(1, 0).Select     'next row
Wend
End Sub

 

[Fluff]

@ranman256 that comes nowhere near what the OP is asking for, all it's doing is clearing the cells and that is NOT what the OP wants.

 

[Mangosteenlu]

The problems arise when you have got two different stock numbes and AVL EQU code e.g. for AD10P35836, do you want "_Delivery" or "HG40/0001" and how do we tell which to use?

Hi Offthelip, thanks for reply. If it is the delivery, just leave as it is. In the example you mentioned, HG40/0001 will be the option, not _delivery. Let me know if you have more questions.

 

[Mangosteenlu]

Run: FixNullCols
add more columns to fix if needed

Sub FixNullCols()

Range("E1").Select
Fix1ColNull

   'DO MORE NEEDED COLUMNS
'Range("f1").Select
'Fix1ColNull
End Sub


Public Sub Fix1ColNull()  'of activecell
Dim vWord, vUsrSrt, vUsrEnd, vFirst, vLast
Dim i As Integer

On Error Resume Next

Cells(1, ActiveCell.Column).Select
While ActiveCell.Value <> ""
   If ActiveCell.Value = "NULL" Then ActiveCell.Value = ""

   ActiveCell.Offset(1, 0).Select     'next row
Wend
End Sub

Hi Ranman256, Thanks for the code. I tested it and did not work the way i want it to be. thanks

 

[Alex Blakenburg]

See if this does what you need.
Note: I have assumed that
• _TRSP & _DELIVERY occur together and am only testing Column E for _TRSP.
• That NULL will appear in both columns and am only testing Column E for NULL

Sub RepeatDetails()
    Dim shtData As Worksheet
    Dim rngData As Range, arrData As Variant
    Dim rowLast As Long, i As Long, iToUse As Long
    Dim dictData As Object, dictKey As String
   
    Set shtData = ActiveSheet                   ' Ideally put in the sheet name using Worksheets("Sheet_Name")
    With shtData
        rowLast = .Range("E" & Rows.Count).End(xlUp).Row
        Set rngData = .Range("C2:F" & rowLast)
        arrData = rngData.Value
    End With

    Set dictData = CreateObject("Scripting.dictionary")
    dictData.CompareMode = vbTextCompare
   
    ' Load details range into Dictionary
    For i = 1 To UBound(arrData)
        dictKey = arrData(i, 1)
        If Not dictData.exists(dictKey) Then
            dictData(dictKey) = 0
        End If
       
        If arrData(i, 3) <> "NULL" And arrData(i, 3) <> "_TRSP" Then
            dictData(dictKey) = i
        End If
    Next i
   
    ' Update Columns E & F to Valid Values
    For i = 1 To UBound(arrData)
        dictKey = arrData(i, 1)
        iToUse = dictData(dictKey)
        If iToUse <> i And iToUse <> 0 And arrData(i, 3) = "NULL" Then
            arrData(i, 3) = arrData(iToUse, 3)
            arrData(i, 4) = arrData(iToUse, 4)
        End If
    Next i
   
    With rngData.Resize(, 1)
        .Offset(, 2).Value = Application.Index(arrData, 0, 3)
        .Offset(, 3).Value = Application.Index(arrData, 0, 4)
    End With
End Sub

In case it helps anyone else who wants to have a go here is my sample data:

20231108 VBA Dictionary Repeat Value Mangosteenlu.xlsm
	C	D	E	F
1	AVN_USER	AVN_RAIS	AVL_EQUAL	AVL_STOCK
2	AD01S35838		NULL	NULL
3	AD01S35838		52PU001H	EXP6451
4	AD01S35838		NULL	NULL
5	AD01S35838		NULL	NULL
6	AD01S35838		NULL	NULL
7	AD01S35838		_TRSP	_DELIVERY
8	AD10P35817		_TRSP	_DELIVERY
9	AD10P35817		NULL	NULL
10	AD10P35817		XH2411	HB37/0002
11	AD10P35825		_TRSP	_DELIVERY
12	AD10P35825		NULL	NULL
13	AD10P35825		NULL	NULL
14	AD10P35825		NULL	NULL
15	AD10P35825		NULL	NULL
16	AD10P35825		32EX003S	EX891
Data

 

[Mangosteenlu]

Sub RepeatDetails()
Dim shtData As Worksheet
Dim rngData As Range, arrData As Variant
Dim rowLast As Long, i As Long, iToUse As Long
Dim dictData As Object, dictKey As String

Set shtData = ActiveSheet ' Ideally put in the sheet name using Worksheets("Sheet_Name")
With shtData
rowLast = .Range("E" & Rows.Count).End(xlUp).Row
Set rngData = .Range("C2:F" & rowLast)
arrData = rngData.Value
End With

Set dictData = CreateObject("Scripting.dictionary")
dictData.CompareMode = vbTextCompare

' Load details range into Dictionary
For i = 1 To UBound(arrData)
dictKey = arrData(i, 1)
If Not dictData.exists(dictKey) Then
dictData(dictKey) = 0
End If

If arrData(i, 3) <> "NULL" And arrData(i, 3) <> "_TRSP" Then
dictData(dictKey) = i
End If
Next i

' Update Columns E & F to Valid Values
For i = 1 To UBound(arrData)
dictKey = arrData(i, 1)
iToUse = dictData(dictKey)
If iToUse <> i And iToUse <> 0 And arrData(i, 3) = "NULL" Then
arrData(i, 3) = arrData(iToUse, 3)
arrData(i, 4) = arrData(iToUse, 4)
End If
Next i

With rngData.Resize(, 1)
.Offset(, 2).Value = Application.Index(arrData, 0, 3)
.Offset(, 3).Value = Application.Index(arrData, 0, 4)
End With
End Sub

Alex,
Thank you so much, you are a star. It works brilliantly, and I wish i could have the skills like you have. thank you

 

[Alex Blakenburg]

Thanks for letting us know. Glad we could help.