Excel VBA If Then Loop conditions -


i've been struggling few days. appreciated!

it's difficult explain, i'll best.

what i'm trying count number of results each query has , categorize them based on result count.

for example if query_a has 1 exact result , query_z has 1 exact result total of 2 queries have 1 result.

i'm trying use loop if statements, i'm @ loss.

here example data , output hoping for: query_example_data_and_results.xlsx - not real spreadsheet thousands of rows of data , large file size.

the code below pull query count (removing query dupes), not give query result count.. have provide code attempts, know i'm not close... have removed failed attempts hoping i'm being clear enough steered in right direction.

sub query_count()  g_40 = 0  query = ""  application.statusbar = " ~~ ~~ query count ~~ running ~~ ~~ " & x  x = 2  until sheets(1).cells(x, 1) = ""      if sheets(1).cells(x, 9) = "yes"     if query <> sheets(1).cells(x, 1)         g_40 = g_40 + 1     end if     end if     query = sheets(1).cells(x, 1)  x = x + 1  loop  application.statusbar = "done running query count of " & x & " rows!"  g = 40 sheets(3).cells(g, 7) = g_40 'query_count:  end sub

thank in advance!

based on example code job: 

option explicit  sub getresults()     application.screenupdating = false      dim ws1 worksheet, ws2 worksheet, lr&         set ws1 = thisworkbook.sheets("example_query_data")         set ws2 = thisworkbook.sheets("example_results")         lr = ws1.range("a" & rows.count).end(xlup).row      dim arr() string, i&, j&, cnt&     dim varr() string     cnt = 0      redim arr(lr - 2)     = 2 lr         arr(i - 2) = cstr(ws1.range("a" & i).value) ' fill array     next     call removeduplicate(arr) 'remove duplicate     redim varr(0 ubound(arr), 0 1)     = lbound(arr) ubound(arr)         varr(i, 0) = arr(i)         varr(i, 1) = getcount(arr(i), ws1, j, lr)     next      call preptable(ws2)     call updatetable(ws2, ws1, varr, j, lr) ' update table      application.screenupdating = true end sub  function getcount(qname$, byref ws1 worksheet, byref i&, lr&)     dim count&     count = 0     = 2 lr         if (strcomp(cstr(ws1.range("a" & i).value), qname, vbtextcompare) = 0) , _               (strcomp(cstr(ws1.range("c" & i).value), "yes", vbtextcompare) = 0) count = count + 1     next     getcount = count ' return count end function  sub updatetable(byref ws worksheet, byref ws2, byref arr() string, byref i&, lr&)     dim tbliter&     tbliter = 2 12         = lbound(arr) ubound(arr)             if arr(i, 1) = tbliter - 1                 ws.range("b" & tbliter).value = ws.range("b" & tbliter).value + 1             end if         next     next tbliter     call elevenandmore(ws, ws2, arr, lr, i) end sub  sub preptable(ws worksheet)     ws.range("b2:b12").clearcontents end sub  sub elevenandmore(byref ws worksheet, byref ws2, byref arr() string, lr&, byref i)     dim cnt&, j&     cnt = 0     = lbound(arr) ubound(arr)      j = 1 lr         if strcomp(cstr(ws2.range("a" & j).value), arr(i, 0), vbtextcompare) = 0             cnt = cnt + 1         end if      next j      if cnt > 10 ws.range("b12").value = ws.range("b12").value + 1      cnt = 0     next end sub  sub removeduplicate(byref stringarray() string)     dim lowbound$, upbound&, a&, b&, cur&, temparray() string     if (not stringarray) = true exit sub ' empty?     lowbound = lbound(stringarray)     upbound = ubound(stringarray)     redim temparray(lowbound upbound)     cur = lowbound ' first item     temparray(cur) = stringarray(lowbound)     = lowbound + 1 upbound         b = lowbound cur             if lenb(temparray(b)) = lenb(stringarray(a))                 if instrb(1, stringarray(a), temparray(b), vbbinarycompare) = 1 exit             end if         next b         if b > cur cur = b: temparray(cur) = stringarray(a)     next     redim preserve temparray(lowbound cur) ' resize     stringarray = temparray ' copy end sub

post-comment edit: change these three:

add +28 tbliter

sub updatetable(byref ws worksheet, byref ws2, byref arr() string, byref i&, lr&)     dim tbliter&     tbliter = 2 12         = lbound(arr) ubound(arr)             if arr(i, 1) = tbliter - 1                 ws.range("b" & tbliter + 28).value = ws.range("b" & tbliter + 28).value + 1             end if         next     next tbliter     call elevenandmore(ws, ws2, arr, lr, i) end sub

simply change location b40

sub elevenandmore(byref ws worksheet, byref ws2, byref arr() string, lr&, byref i)     dim cnt&, j&     cnt = 0     = lbound(arr) ubound(arr)      j = 1 lr         if strcomp(cstr(ws2.range("a" & j).value), arr(i, 0), vbtextcompare) = 0             cnt = cnt + 1         end if      next j      if cnt > 10 ws.range("b40").value = ws.range("b40").value + 1      cnt = 0     next end sub

and prep table change range

sub preptable(ws worksheet)     ws.range("b30:b40").clearcontents end sub

and should do!


Comments

Post a Comment

Popular posts from this blog

Why does Ruby on Rails generate add a blank line to the end of a file? -

running rails generate controller foo home results in: class foocontroller < application controller def home end end (there's nothing on line in actual file, blank line) is there purpose blank line? it's common use newline indicate end of line, last line. many editors (like vi, use) add in newline silently. consensus text files (especially in unix world) should end in newline, , there have been problems historically if wasn't present. why should text files end newline? the tool used count lines in file "wc" counts newlines in file, without trailing newline show 3 instead of 4. it improves readability of templates used in generator. consider: https://github.com/rails/rails/blob/master/railties/lib/rails/generators/rails/controller/templates/controller.rb to remove trailing newline, template have last line of: end<% end -%> instead of: end <% end -%> that seems less readable me. the discussion below refers ...
Read more

keyboard - Smiles and long press feature in Android -

i've created android keyboard. how add features inserting smilies, , using long keypresses display symbols? to create long-press behavior allows select several options pop-up menu, follow guide (specifically pop-up menu section): http://developer.android.com/guide/topics/ui/menus.html smileys (also known emoticons) combination of keys, understood programs , parsed same way. have do, when clicks smiley face on keyboard, simulate pressing of key combination matching emoticon. example, when clicks smiley, should simulate key presses ':' , ')' :). here's list of emoticons: http://en.wikipedia.org/wiki/list_of_emoticons
Read more

node.js - Bad Request - node js ajax post -

i'm using express 3.0 , node v0.11.0. have button submits form , i'm using ajax post data json object node server. client code is: $('#contact').submit(function(e) { console.log('submit called'); var formdata = json.stringify($('form').serializeobject()); console.log(formdata); $.ajax({ url: "http://localhost:3000/savedata/", type: "post", datatype: 'json', data: {objectdata: formdata}, contenttype: "application/json", complete: function() { console.log('process complete'); }, success: function(data) { console.log('process sucess'); }, error: function() { console.log('process error'); }, }); return false; }); then on server: var express = require('express'); var app = express(); app.set('views', __dirname + '/views'); app.set('view engine', 'jade'); app.use(express.bodyparser());...
Read more