Can anyone change my code to another that uses Array?

kbj0109

New Member
Joined
Mar 28, 2015
Messages
26
This is my code right now,
I set the j and i start from 4, because the list starts from the 4th row.

I have a list of people with the number assigned to each of them at column A and B.
I want to make a new list of people who has the number greater than 500 at column D and E.

Can anyone fix this code to another that uses Arrays to insert the values I want at Column D and E?

Sub MyCode ()

j = 4

For i = 4 To Range("A" & Rows.Count).End(xlUp).Row

If Range("B" & i).Value >= 500 Then

Range("D" & j).Value = Range("A" & i).Value
Range("E" & j).Value = Range("B" & i).Value
j = j + 1
End If

Next i
End Sub


This is the code I'm trying to make, but not working..

Sub NewCode ()

Dim Names(1 to 93) as String
Dim Numbers(1 to 93) as Integer
Dim i as Integer, j as Integer

j = 4 to 96

For i = 4 To 96
Names() = Range("A" & j).Value
Amounts() = Range("B" & i). Value


If Amounts() >= 500 Then

Range("D" & j).Value = Names().Value
Range("E" & j).Value = Amounts().Value
j = j + 1
End If

Next i

End Sub


Can't assign Array,,, don't know why..
Anyone can help me out?
Hope that new list in column D and E does not have blank cells between each values.
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Try this...

Code:
[color=darkblue]Sub[/color] NewCode()
    
    [color=darkblue]Dim[/color] AB [color=darkblue]As[/color] [color=darkblue]Variant[/color], i [color=darkblue]As[/color] [color=darkblue]Long[/color], j [color=darkblue]As[/color] Long
    
    AB = Range("A4", Range("B" & Rows.Count).End(xlUp)).Value
    
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](AB, 1)
        
        [color=darkblue]If[/color] AB(i, 2) >= 500 [color=darkblue]Then[/color]
            j = j + 1
            AB(j, 1) = AB(i, 1)
            AB(j, 2) = AB(i, 2)
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        AB(i, 1) = ""
        AB(i, 2) = ""
        
    [color=darkblue]Next[/color] i
    
    Range("D4:E4").Resize(UBound(AB, 1)).Value = AB
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Also, please take note of my signature block below about the use of CODE tags. It makes reading your code in the forums much easier.
 
Upvote 0
Thanks for your help AlphaFrog.
though... Is there any way that I can keep the two arrays that I made?

I keep getting an error message sayings 'Expected array' at the point I made it bold.

and this code does not give me first three people's name and new list starts from D7.
maybe with the lost three people, it could start from D4.. I don't know why.

This is the code that I'm trying to make based on your code.
Sub NewCode()

Dim Amounts As Variant, i As Long, j As Long
Dim Names As String

Amounts = Range("B4:B" & Range("B" & Rows.Count).End(xlDown).Row)
Names = Range("A4:A" & Range("A" & Rows.Count).End(xlDown).Row)

For i = 1 To UBound(Amounts, 1)

If Amounts(i, 2) >= 500 Then
j = j + 1
Names(j, 1) = Names(i, 1)
Amounts(j, 2) = Amounts(i, 2)
End If
Names(i, 1) = ""
Amounts(i, 2) = ""

Next i

Range("D4:E4").Resize(UBound(Amounts, 1)).Value = Amounts

End Sub
 
Upvote 0
You might know that the formula solution to this problem is much simpler:


Excel 2010
ABCDE
1NameNumber
2AZ581AZ581
3AQ446OP690
4AW471ZZ504
5GT468SD661
6YY410
7OP690
8BV424
9ZZ504
10SD661
11FJ425
Sheet19
Cell Formulas
RangeFormula
D2{=INDEX(A$1:A$11,SMALL(IF($B$2:$B$11>500,ROW($B$2:$B$11)),ROW(A1)))}
Press CTRL+SHIFT+ENTER to enter array formulas.


But if you must have a coded array for whatever reason then AlphaFrog's is the way to go
 
Upvote 0
Thanks for your help AlphaFrog.
though... Is there any way that I can keep the two arrays that I made?

I keep getting an error message sayings 'Expected array' at the point I made it bold.

and this code does not give me first three people's name and new list starts from D7.
maybe with the lost three people, it could start from D4.. I don't know why.

This is the code that I'm trying to make based on your code.
Code:
Sub NewCode()
    
    Dim Amounts As Variant, i As Long, j As Long
    Dim Names As String
    
    Amounts = Range("B4:B" & Range("B" & Rows.Count).End(xlDown).Row)
    Names = Range("A4:A" & Range("A" & Rows.Count).End(xlDown).Row)
    
    For i = 1 To UBound(Amounts, 1)
        
        If Amounts(i, 2) >= 500 Then
            j = j + 1
[B]            Names(j, 1) = Names(i, 1)[/B]
            Amounts(j, 2) = Amounts(i, 2)
        End If
        Names(i, 1) = ""
        Amounts(i, 2) = ""
        
    Next i
    
    Range("D4:E4").Resize(UBound(Amounts, 1)).Value = Amounts
    
End Sub

Use CODE tags please.

Code:
[COLOR=darkblue]Sub[/COLOR] NewCode()
    
    [COLOR=darkblue]Dim[/COLOR] Amounts [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], Names [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], j [COLOR=darkblue]As[/COLOR] Long
    
    Amounts = Range("B4", Range("B" & Rows.Count).End(xlUp)).Value
    Names = Range("A4", Range("A" & Rows.Count).End(xlUp)).Value
    
    [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](Amounts, 1)
        
        [COLOR=darkblue]If[/COLOR] Amounts(i, 1) >= 500 [COLOR=darkblue]Then[/COLOR]
            j = j + 1
            Names(j, 1) = Names(i, 1)
            Amounts(j, 1) = Amounts(i, 1)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        Names(i, 1) = ""
        Amounts(i, 1) = ""
        
    [COLOR=darkblue]Next[/COLOR] i
    
    Range("D4").Resize(UBound(Names, 1)).Value = Names
    Range("E4").Resize(UBound(Amounts, 1)).Value = Amounts
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0
kbj0109,

No more Private Messages - please.

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?


Because of description of your raw data, and, results, screenshots will not do.

3. Can we see your workbook/worksheet's raw data, and, results (manually formatted by you) for the results you are looking for.?


You can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.
 
Upvote 0
Sorry, I thought I sent you the private message one time, but I guess the messages went to you for several times..

I'm using Excel 2013, and Windows8 in PC.
 
Upvote 0
kbj0109,

Because of description of your raw data, and, results, screenshots will not do.

3. Can we see your workbook/worksheet's raw data, and, results (manually formatted by you) for the results you are looking for.?

You can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.
 
Upvote 0
kbj0109,

You have not posted your workbook, so I used sheetspread's raw data, modified to fit your description of your raw data.

The below macro uses two arrays in memory.

Sample raw data, and, results in Sheet1 (you can change the sheet name in the macro):


Excel 2007
ABCDE
3NameNumber
4AZ581AZ581
5AQ446OP690
6AW471ZZ504
7GT468SD661
8YY410
9OP690
10BV424
11ZZ504
12SD661
13FJ425
14
Sheet1


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).

Code:
Sub CopyGreaterThan500()
' hiker95, 04/26/2015, ME851317
Dim a As Variant, o As Variant
Dim i As Long, j As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  a = .Range("A4:B" & .Range("A" & Rows.Count).End(xlUp).Row)
  n = Application.CountIf(.Range("B4:B" & .Range("A" & Rows.Count).End(xlUp).Row), ">500")
  ReDim o(1 To n, 1 To 2)
  For i = 1 To UBound(a, 1)
    If a(i, 2) > 500 Then
      j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, 2)
    End If
  Next i
  .Range("D4:E" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
  .Range("D4").Resize(UBound(o, 1), UBound(o, 2)) = o
  .Range("D4:E" & .Range("A" & Rows.Count).End(xlUp).Row).Columns.AutoFit
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the CopyGreaterThan500 macro.
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,947
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top