Help!! Vba code correction

[kajeet]

Hello all,

Schedule	Details	Impact	Verification	validation
a	1	@	one	y
b	2	#	two	y
c	3	$	three	n
d	4	%	four	n

<tbody>
</tbody>

The problem with the code below is it excutes the output for all the cells without validating the condition in column E.

Any help to rectify this problem will be appreciated.
I only want the output for cells that have the validation as y

I have this code in VBA as follows

Sub validate()
For Each c In Range("E1:E20")
If c.Value = "y" Then Macro1
Next c
End Sub

Sub Macro1()
'
' Macro1 Macro
'
Dim rngCopy() As Variant
Dim rngPaste As Range
Dim Heading As Variant
Dim Cell As Range
Dim r As Integer
Heading = Array("Schedule", "Details", "Impact", "Verification")
r = 0

For Each Cell In Sheets(1).Range("A2", Sheets(1).Range("A" & Rows.Count).End(xlUp))
rngCopy() = Sheets(1).Range(Cell, Cell.Offset(0, 4)).Value
Set rngPaste = Sheets(2).Range("B" & 2 + r).Resize(4, 1)
rngPaste = Application.Transpose(rngCopy)
Sheets(2).Range("A" & 2 + r & ":A" & 5 + r).Value = Application.Transpose(Heading)
r = r + 5
Next Cell
End Sub

 

[hiker95]

kajeet,

I assume that worksheets Sheet1 and Sheet2 already exist.

Sample raw data in worksheet Sheet1:

Excel 2007
	A	B	C	D	E
1	Schedule	Details	Impact	Verification	validation
2	a	1	@	one	y
3	b	2	#	two	y
4	c	3	$	three	n
5	d	4	%	four	n
6
Sheet1

After the fast macro using two arrays in memory in worksheet Sheet2:

Excel 2007
	A	B	C	D
1	Schedule	Details	Impact	Verification
2	a	1	@	one
3	b	2	#	two
4
Sheet2

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ValidateY()
' hiker95, 06/13/2013
' http://www.mrexcel.com/forum/excel-questions/708319-help-visual-basic-applications-code-correction.html
Dim a As Variant, b As Variant
Dim i As Long, ii As Long, c As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  n = Application.CountIf(.Columns(5), "y")
  If n = 0 Then
    MsgBox "There are no 'y' validations in column E - macro terminated!!!"
    Exit Sub
  End If
  a = .Cells(1).CurrentRegion
  ReDim b(1 To n + 1, 1 To 4)
End With
ii = 1
For c = 1 To 4
  b(ii, c) = a(1, c)
Next c
For i = 2 To UBound(a, 1)
  If a(i, 5) = "y" Then
    ii = ii + 1
    For c = 1 To 4
      b(ii, c) = a(i, c)
    Next c
  End If
Next i
With Sheets("Sheet2")
  .UsedRange.ClearContents
  .Cells(1).Resize(UBound(b, 1), UBound(b, 2)) = b
  .Columns.AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ValidateY macro.