CODEWITHSUNDEEP
vbaexcel
tylerj
tylerj

Reputation: 3

Improve VBA to check data in column

I'm trying to implement additional code where it checks the data whether it's valid or not. If isn't, then the data is omitted from copying to the current workbook.

An invalid data is anywhere between -0.01 to 0.01

Sub TransferTRA015()

Dim strPath2 As String
Dim strPath3 As String
Dim strPath4 As String
Dim wbkWorkbook1 As Workbook
Dim wbkWorkbook2 As Workbook
Dim wbkWorkbook3 As Workbook
Dim wbkWorkbook4 As Workbook

strPath2 = "C:\Users\transducer1.CCS\Desktop\LabVIEW Data\TRA015\TRA015_TEST_Room.xlsx"
strPath3 = "C:\Users\transducer1.CCS\Desktop\LabVIEW Data\TRA015\TRA015_TEST_Cold.xlsx"
strPath4 = "C:\Users\transducer1.CCS\Desktop\LabVIEW Data\TRA015\TRA015_TEST_Hot.xlsx"


Set wbkWorkbook1 = ThisWorkbook '### changed this
Set wbkWorkbook2 = Workbooks.Open(strPath2)
Set wbkWorkbook3 = Workbooks.Open(strPath3)
Set wbkWorkbook4 = Workbooks.Open(strPath4)

'copy the values across
'### change the sheet and range to what you need
wbkWorkbook1.Worksheets("RAW DATA").Range("A13:Y36").Value = _
    wbkWorkbook2.Worksheets("sheet1").Range("A2:Y25").Value

wbkWorkbook1.Worksheets("RAW DATA").Range("A5:Y8").Value = _
    wbkWorkbook4.Worksheets("sheet1").Range("A2:Y5").Value

wbkWorkbook1.Worksheets("RAW DATA").Range("A40:Y43").Value = _
    wbkWorkbook3.Worksheets("sheet1").Range("A2:Y5").Value

wbkWorkbook2.Close (True)
wbkWorkbook3.Close (True)
wbkWorkbook4.Close (True)
End Sub

Upvotes: 0

Views: 141

Answers (1)

Ryszard Jędraszyk
Ryszard Jędraszyk

Reputation: 2412

You can't copy data like this, if you choose a range which has a lot of cells, the value of this range equals the value of the cell in upper left corner.

Add the following to your code to copy only specified range of values from wbkWorkbook2.Worksheets("sheet1") to wbkWorkbook1.Worksheets("RAW DATA") in the quickest way VBA has to offer.

Dim vSource as Variant
Dim LastRow as long, arrayRow as long, arrayCol as long 

With wbkWorkbook2.Worksheets("sheet1")
   'find last row with data in the sheet
    LastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    vSource = .Range("a2:y" & LastRow) 'or .Range("A2:Y25") if for example
                                       'you only need this specified part of data

    For arrayRow = Lbound(vSource) to Ubound(vSource)
        For arrayCol = Lbound(vSource,2) to Ubound(vSource,2)
            If vSource(arrayRow,arrayCol)<0.01 and vSource(arrayRow,arrayCol)>-0.01 then
                vSource(arrayRow,arrayCol)=vbNullString
            End if
        Next arrayCol
    Next arrayRow        

End With

wbkWorkbook1.Worksheets("RAW DATA").Range("A13:Y36") = vSource

Upvotes: 1

Related Questions