7A65726F
7A65726F

Reputation: 167

Iterate all rows in date and store the month value to the last column

I'm trying to loop through a column(A) that contains date and create an arbitrary column(lastcolumn+1) and store only the month value from the column(A) which contains the date. Please help me!

Code: what my code is doing is copying the column and paste it the specified can someone help me to improve my code?

 Public Sub Selection()

Dim file1 As Excel.Workbook
Dim Sheet1 As Worksheet
Dim serviceIDRng As Range
Dim lngLastRow As Long
Dim rngSheet1 As Range
Dim NextRow As Long
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long

Set Sheet1 = Workbooks.Open(TextBox1.Text).Sheets(1)

'lngLastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
'Set serviceIDRng = Sheet1.Range("T1:T" & lngLastRow)

    Application.ScreenUpdating = False

    With Sheet1
        NextRow = .Cells(.Rows.Count, "E").End(xlUp).Row + 1
    End With

    With Sheet1
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For c = 1 To LastCol
            LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
            Set rngSheet1 = .Range(.Cells(3, c), .Cells(LastRow, c))
            rngSource.Copy Sheet1.Range("E" & NextRow)
            NextRow = NextRow + rngSheet1.Rows.Count
        Next c
    End With

    Application.ScreenUpdating = True

    MsgBox "Succes!", vbExclamation

End Sub

Upvotes: 1

Views: 55

Answers (1)

Florent B.
Florent B.

Reputation: 42528

To extract the month from column "E" to a new column:

Public Sub Selection()
  Dim ws As Worksheet, data(), i&
  Set ws = Workbooks.Open(TextBox1.text).sheets(1)

  ' load the data from column E
  data = Intersect(ws.Columns("E"), ws.UsedRange)

  'set the title
  data(1, 1) = "Month"

  ' extract the month
  For i = 2 To UBound(data)
    If VarType(data(i, 1)) = vbDate Then
      data(i, 1) = Month(data(i, 1))
    End If
  Next

  ' write the data back to the sheet
  ws.UsedRange.Columns(ws.UsedRange.Columns.count + 1) = data

  MsgBox "Succes!", vbExclamation

End Sub

Upvotes: 2

Related Questions