CODEWITHSUNDEEP
vbaexcel
Charvi
Charvi

Reputation: 255

Offset function on selective columns in Excel VBA

Bit new to VBA. It seems quite simple though; am not able to figure it out how to use Offset function and While/Do while loop here.

I am making an excel form where columns A to L will have values.

Out of which few columns are mandatory. Those are A, B, C, D, F, G, H, I, J, L.

Which means those can't be left blank and other columns can be blank.

My excel looks like below.

MyExcel

I have written a code where it checks whether mandatory columns have values or not.

The code is as below : 

    Dim celadr, celval As Variant
    Dim cell As Variant

    Dim LastRow As Long
    LastRow = Range("A65536").End(xlUp).Row

    On Error GoTo 0
    shname = ActiveSheet.Name

    Dim celArray, arr, Key1, KeyCell As Variant

    celArray = ("A,B,C,D,F,G,H,I,J,L")
    arr = Split(celArray, ",")
    For Key1 = LBound(arr) To UBound(arr)
    KeyCell = arr(Key1)
    Range(KeyCell & "2:" & KeyCell & "" & LastRow).Select
    'Selection.Clearformats
    For Each cell In Selection
        celadr = cell.Address
        celval = cell.Value
      If celval = "" Then
            Range(celadr).Interior.Color = vbRed
            strErr = Range(celadr).Value
            Sheets("Observations").Range("A65536").End(xlUp).Offset(1, 0).Value = IIf(strErr = "", "Empty Found", strErr)
            strstr = "'" & shname & "'!" & Range(celadr).Address(0, 0)
            Sheets("Observations").Hyperlinks.Add Anchor:=Sheets("Observations").Range("A65536").End(xlUp), Address:="", SubAddress:= _
            strstr, TextToDisplay:=IIf(strErr = "", "Empty Found", strErr)
       End If

    Next cell
    Next Key1

The result of this code is;

1) between each two school records a row may be left blank. My above code will color such all rows also in red background. (It should not happen)

2) Columns B, C, D, F, G, H can have values only in the same row in which school_name is mentioned. So, if following rows for same school are left blank then those also will be colored in red background. (It should not happen).

So; I want to make small correction to code:

I want to add a condition to code:

"When there is a value in Column A; then only the above code should be exceuted."

I tried to achieve it as I have written in below Code. Still, am not upto.

I have commented all such lines of code which were giving me error (from below code):

    Dim celadr, celval, celadr1, celval1 As Variant
    Dim cell, cell1 As Variant

    Dim LastRow As Long
    LastRow = Range("A65536").End(xlUp).Row

    On Error GoTo 0
    shname = ActiveSheet.Name


    Dim celArray, arr, Key1, KeyCell As Variant
    'Range("A2:A" & LastRow).Select    
    'For Each cell1 In Selection        
        'celadr1 = cell1.Address
        'celval1 = cell1.Value
    'Do While Len(celval1) >= 1

    celArray = ("A,B,C,D,F,G,H,I,J,L")
    arr = Split(celArray, ",")
    For Key1 = LBound(arr) To UBound(arr)
    KeyCell = arr(Key1)
    Range(KeyCell & "2:" & KeyCell & "" & LastRow).Select
    'Selection.Clearformats
    For Each cell In Selection
        celadr = cell.Address
        celval = cell.Value
        ' May be another loop over here to increment value in offset function according to column number.
      If celval = "" Then 'And Offset Function Referring to column A, same row.
            Range(celadr).Interior.Color = vbRed
            strErr = Range(celadr).Value
            Sheets("Observations").Range("A65536").End(xlUp).Offset(1, 0).Value = IIf(strErr = "", "Empty Found", strErr)
            strstr = "'" & shname & "'!" & Range(celadr).Address(0, 0)
            Sheets("Observations").Hyperlinks.Add Anchor:=Sheets("Observations").Range("A65536").End(xlUp), Address:="", SubAddress:= _
            strstr, TextToDisplay:=IIf(strErr = "", "Empty Found", strErr)
       End If
    ' End If
    Next cell
    Next Key1
    ' Loop

Can someone guide me how I can make correct use of offset function/while loops here?

Edit:

Assume, XYZ School don't have value for No. of Teachers

And

PQRS School don't have value for No. of students

My Current output is as in below image:

My_Excel2

Where as Expected Output is:

My_Excel1

Upvotes: 0

Views: 631

Answers (1)

DyRuss
DyRuss

Reputation: 502

I think the below code should work - try it out and let me know if there are any issues:

Sub Your_Macro()
    Dim celArray, item As Variant
    Dim LastRow, x As Long
    LastRow = Cells(rows.Count, "A").End(xlUp).row
    celArray = ("A,B,C,D,F,G,H,I,J,L")
    celArray = Split(celArray, ",")
    For x = 2 To LastRow
        If Not IsEmpty(Cells(x, "A")) Then
            For Each item In celArray
                If IsEmpty(Cells(x, item)) Then
                    Cells(x, item).Interior.Color = vbRed
                End If
            Next item
        End If
    Next x
End Sub

Upvotes: 1

Related Questions