VBA, search in range of data and then copy and paste

[dinokovac93]

Hi Guys,

I'm working on a extremely tedious project and my hands are about to fall off .

So to give you an idea of what I'm doing, check out this GIF:

(Note: In the GIF: there are more columns to fill out)

So I'm not sure if there is a VBA possible for filling out all of the information.

What the Macro would need to do is (or at least what I think it needs):

1. Search (loop) through the ranges of data in sheet 5.

2. It will copy and paste all the dates from sheet 5 (which are always in column A) into sheet 6 dates column.

3. Now sheet 6 has the dates filled out, along with the column names. This is the key information to taking data from sheet 5 and putting it in sheet 6.

4. There are more columns in sheet 5 but we only need the columns that are in sheet 6.

5. The columns's names in sheet 6 match the same columns in sheet 5.

6. To wrap it up: the macro will use the dates and column names from sheet 6 to obtain the data from sheet 5.


If anyone get help or have any suggestions please let me know, its really appreciated.

Subject ID

name

visit_date

intraocular pressure - right

intraocular pressure - left

VA - Right Distance SC

VA - Right Distance SC +-

VA - Right Distance CC

VA - Right Distance CC +-

VA - Right Distance PH SC

VA - Right Distance PH CC

VA - Left Distance SC

VA - Left Distance SC +-

VA - Left Distance CC

VA - Left Distance CC +-

VA - Left Distance PH SC

VA - Left Distance PH CC

VA Type

Wearing Rx - Right Sphere

Wearing Rx - Right Cylinder

Wearing Rx - Right Axis

Wearing Rx - Right Add

Wearing Rx - Left Sphere

Wearing Rx - Left Cylinder

Wearing Rx - Left Axis

Wearing Rx - Left Add

Wearing Rx - Current Age

Manifest Refraction - Right Sphere

Manifest Refraction - Right Cylinder

Manifest Refraction - Right Axis

Manifest Refraction - Right Add

Manifest Refraction - Right Dist VA

Manifest Refraction - Right Near VA

Manifest Refraction - Left Sphere

Manifest Refraction - Left Cylinder

Manifest Refraction - Left Axis

Manifest Refraction - Left Add

Manifest Refraction - Left Dist VA

Refraction Type

Pachymetry - Right Eye

Pachymetry - Left Eye

external exam - right eye

external exam - left eye

Slit Lamp Exam - Right Lids

Slit Lamp Exam - Right Conjunctiva

Slit Lamp Exam - Right Cornea

Slit Lamp Exam - Right AC

Slit Lamp Exam - Right Lens

Slit Lamp Exam - Right Iris

Slit Lamp Exam - Right Vitreous

Slit Lamp Exam - Left Lids

Slit Lamp Exam - Left Conjunctiva

Slit Lamp Exam - Left Cornea

Slit Lamp Exam - Left AC

Slit Lamp Exam - Left Lens

Slit Lamp Exam - Left Iris

Slit Lamp Exam - Left Vitreous

Fundus Exam - Right Disc

Fundus Exam - Right Macula

Fundus Exam - Right Periphery

Fundus Exam - Right Vessels

Fundus Exam - Left Disc

Fundus Exam - Left Macula

Fundus Exam - Left Periphery

Fundus Exam - Left Vessels

Fundus Exam - Right Cup/Disc Ratio

Fundus Exam - Left Cup/Disc Ratio

<tbody>
</tbody>

 

[CalcSux78]

Here's a start...

Option Explicit



Sub dinokovac93()
Dim lrow&, col&
Dim cel As Range
Dim rng As Range


With Sheet5
    lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range(.[A2], .Cells(lrow, 1)).Copy Sheet6.[C2]   'copy dates
End With


With Sheet6
    'set rng with column headers from sheet 6
    Set rng = .Range(.[D1], .Cells(1, .Columns.Count).End(xlToLeft))
    For Each cel In rng.Cells
        If WorksheetFunction.CountIf(Sheet5.Rows(1), cel) > 0 Then
            col = WorksheetFunction.Match(cel.Value, Sheet5.Rows(1), 0)
            Sheet5.Range(Sheet5.Cells(2, col), Sheet5.Cells(lrow, col)).Copy cel.Offset(1)
        End If
    Next cel
End With


End Sub

This sub uses a FOR loop to find matches in the first row of the two sheets. When a match is found, the range is copied to the destination sheet.