Follow

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use
Contact

Create sheets with Excel VBA based on values in other column

enter image description here

I have the following VBA code to create sheets from a list ‘Analysepakket’ with range D19:D33 as shown in picture.
How do I alter my VBA code so it only makes new sheets where the value ‘J’ or ‘j’ is found in the other column?

Sub CreateSheetsFromList()

Dim ws As Worksheet, Ct As Long, c As Range
Set ws = Worksheets("Opdrachtregistratie")
Application.ScreenUpdating = False
For Each c In Sheets("Laboratorium").Range("D19:D33")
    If c.Value <> "" Then
        ws.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Replace(Left(c.Value, 30), "/", "-")
        Ct = Ct + 1
    End If
Range("C30").Value = c.Value
Next c
If Ct > 0 Then
    MsgBox Ct & " new sheets created from list"
Else
    MsgBox "No names on list"
End If
Application.ScreenUpdating = True

End Sub

MEDevel.com: Open-source for Healthcare and Education

Collecting and validating open-source software for healthcare, education, enterprise, development, medical imaging, medical records, and digital pathology.

Visit Medevel

>Solution :

You can check the value of a cell relative to another cell with the Offset method. This method get 2 parameters, the first is the number of rows, the second the number of columns. Both parameter can be 0 (stay on the same row resp. column) and negative (go to the top resp. to the left).

To read the cell left to another cell, you can use Offset(0, -1) – the 0 says you want to read the same row, the -1 is the column at the left.

Simply change your If-condition to

If c.Value <> "" And UCase(c.Offset(0, -1).Value) = "J" Then
Add a comment

Leave a Reply

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use

Discover more from Dev solutions

Subscribe now to keep reading and get access to the full archive.

Continue reading